在工作表值中查找数组数据

我有一个这样的表格：

Pendergrass (606)-663-4567 Rich (606)-667-4567 Scott (606)-987-4567 Dennis (606)-233-4567 David (606)-888-4567 Red (606)-567-4567 Wendy (606)-765-4567 Todd (606)-677-4567 Andrea (606)-780-3451 Caroline (606)-992-7865 

和我使用的代码如下所示：

 Private Sub CommandButton2_Click() Dim ws As Worksheet, bFound As Boolean, rFound As Range Dim a As Long, aNames As Variant aNames = Array("David", "Andrea", "Caroline") For Each ws In ThisWorkbook.Worksheets 'If ws.Name <> Worksheets("Report").Name Then If ws.Name = "Sheet1" Then With ws.Range("A1:E30").Cells For a = LBound(aNames) To UBound(aNames) Set rFound = .Find(What:=aNames(a), MatchCase:=False, LookAt:=xlWhole, SearchFormat:=False) If Not rFound Is Nothing Then bFound = True With Worksheets("Report") .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0) = rFound.Value End With End If Next a End With End If Next ws If Not bFound Then MsgBox "None of the sheets contains the names " & Chr(10) & _ "'" & Join(aNames, "', '") & "' in cells A1:E30.", vbInformation, "Not Found" End If End Sub 

我想如果把David ， Andrea和Caroline的数字，并把它们放在Report页面的任何地方。 这只抓住一个。

任何人都可以build议我去哪里错了这个代码？

Answer 1

尝试下面的代码。

但是，不知道为什么你要循环遍历所有工作表，在这个工作If ws.Name = "Sheet1" Then ，如果在下面这一行你检查If ws.Name = "Sheet1" Then 。

您可以replace下面的行（删除For ， With和If ）：

 For Each ws In ThisWorkbook.Worksheets With ws 'If ws.Name <> Worksheets("Report").Name Then If .Name = "Sheet1" Then With .Range("A1:E30").Cells 

用一个简单的：

 With Worksheets("Sheet1").Range("A1:E30").Cells 

码

 Private Sub CommandButton2_Click() Dim ws As Worksheet, bFound As Boolean, rFound As Range Dim a As Long, aNames As Variant aNames = Array("David", "Andrea", "Caroline") For Each ws In ThisWorkbook.Worksheets With ws 'If ws.Name <> Worksheets("Report").Name Then If .Name = "Sheet1" Then With .Range("A1:E30").Cells For a = LBound(aNames) To UBound(aNames) Set rFound = .Find(What:=aNames(a), MatchCase:=False, LookAt:=xlWhole, SearchFormat:=False) If Not rFound Is Nothing Then bFound = True Worksheets("Report").Cells(Worksheets("Report").Rows.Count, 1).End(xlUp).Offset(1) = rFound.Value Worksheets("Report").Cells(Worksheets("Report").Rows.Count, 1).End(xlUp).Offset(, 1) = rFound.Offset(, 1).Value End If Next a End With End If End With Next ws If Not bFound Then MsgBox "None of the sheets contains the names " & Chr(10) & _ "'" & Join(aNames, "', '") & "' in cells A1:E30.", vbInformation, "Not Found" End If End Sub