2011-08-31 102 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 
相关问题