2011-08-31 104 views
1

我試圖在Excel中爲我的計劃創建樹遍歷。我處於每個1006個單元長的2個列表。第一個是前輩,第二個是繼任者。我正在嘗試使用一組函數來顯示多個結果。例如,如果我輸入3,我希望任務3的所有後繼者都被列出。到目前爲止,我已經拿出代碼:EXCEL - 在列表中查找一個值並返回多個相應的值

=IF(ISERROR(INDEX($A$1:$B$1006,SMALL(IF($A$1:$A$1006=$E$3,ROW($A$1:$A$1006)),ROW(1:1)),2)),"NO",INDEX($A$1:$B$1006,SMALL(IF($A$1:$A$1006=$E$3,ROW($A$1:$A$1006)),ROW(1:1)),2)) 

然而,當我輸入的前身,它並沒有顯示正確的繼任者。

預先感謝您對誰可以幫我

+0

可以添加表頭和很少有示例數據行來說明您的問題 - 謝謝! – MikeD

回答

0

不能join值與公式(或者至少,我不能看到一個簡單的方法來做到這一點)。

您可以調用一個過程(速度較快,但更具侵入性):

Option Explicit 

Sub Proc_ListPre() 
Dim rData As Range, lLastrow As Long, i As Integer 
Dim aValues() As Variant 
Dim sFilter As String, sRes As String 

'Ask for the value to filter to the user 
sFilter = InputBox("Which predecessor do you want to analyse?", "Please type the predecessor you want") 
If Len(sFilter) = 0 Then Exit Sub 

'Define the range 
'either use UsedRange (if only columns A and B are used) 
'Set rData = ActiveSheet.UsedRange 
'or use End(xlUp) if not 
lLastrow = ActiveSheet.Range("a65536").End(xlUp).Row 
Set rData = ActiveSheet.Range("A1:B" & lLastrow) 
'Filter the predecessor with the criteria given in arg 
rData.AutoFilter Field:=1, Criteria1:=sFilter 

'Find the last row of the filtered data 
lLastrow = ActiveSheet.Range("a65536").End(xlUp).Row 
aValues = ActiveSheet.Range("A2:B" & lLastrow).Value 
'Join the 2nd column of the array 
'Join(WorksheetFunction.Index(aValues, 0, 2), ";") 'note that this doesn't work because index returns a 2D array 
'Workaround to join the 2nd column 
For i = 1 To UBound(aValues, 1) 
    If Len(CStr(aValues(i, 2))) > 0 Then 
     sRes = sRes & aValues(i, 2) & ";" 
    End If 
Next 
sRes = Left(sRes, Len(sRes) - 1) 
MsgBox sRes 

ActiveSheet.AutoFilterMode = False 
End Sub 

,或者使用一個公式,您將在工作表中調用爲=ListPre(mypredecessor)

Function ListPre(ByVal sFilter As String) 
Dim rData As Range, lLastrow As Long, i As Integer 
Dim aValues() As Variant 
Dim sRes As String 

'Define the range 
'either use UsedRange (if only columns A and B are used) 
'Set rData = ActiveSheet.UsedRange 
'or use End(xlUp) if not 
lLastrow = ActiveSheet.Range("a65536").End(xlUp).Row 
Set rData = ActiveSheet.Range("A1:B" & lLastrow) 
aValues = ActiveSheet.Range("A2:B" & lLastrow).Value 

'Join the 2nd column of the array 
'Join(WorksheetFunction.Index(aValues, 0, 2), ";") 'note that this doesn't work because it returns a 2D array 
'Workaround to join the 2nd column 
For i = 1 To UBound(aValues, 1) 
    If Len(CStr(aValues(i, 2))) > 0 And CStr(aValues(i, 1)) = sFilter Then 
     sRes = sRes & aValues(i, 2) & ";" 
    End If 
Next 
sRes = Left(sRes, Len(sRes) - 1) 
ListPre = sRes 
End Function 
相關問題