将search从一个单元格更改为整个工作表

我尝试过改变的地方有一个单元格的范围和其他的东西，但我不明白。 我希望代码search整个工作表，而不是一个单元格，这些名称，并将其右侧的单元格的信息粘贴到另一个工作表。

Option Explicit Private Sub CommandButton1_Click() Dim ws As Worksheet, myCounter As Long Dim erow As Long, myValue As Long Dim nextValue As Long For Each ws In ThisWorkbook.Sheets With ws Select Case .Range("C3").Value Case "David", "Andrea", "Caroline" myCounter = 1 ' raise flag >> found in at least 1 sheet ' get first empty row in "Report" sheet erow = Worksheets("Report").Cells(Worksheets("Report").Rows.Count, 1).End(xlUp).Offset(1, 0).Row Worksheets("Report").Cells(erow, 1) = .Range("C3").Value End Select ' Select Case .Range("C3").Value End With Next ws If myCounter = 0 Then MsgBox "None of the sheets contains the names " & Chr(10) & " 'David', 'Andrea', 'Caroline' in cell C3 ", vbInformation, "Not Found" End If End Sub 

Answer 1

您可以使用Application.Match与数组版本。 replace为你的循环：

 Dim ar, r For Each ws In ThisWorkbook.Sheets ar = Application.match(Array("David", "Andrea", "Caroline"), ws.Columns("C"), 0) For Each r In ar If Not IsError(r) Then myCounter = 1 ' raise flag >> found in at least 1 sheet erow = Worksheets("Report").Cells(Worksheets("Report").Rows.Count, 1).End(xlUp).Offset(1, 0).row Worksheets("Report").Cells(erow, 1) = ws.Range("C" & r).value Worksheets("Report").Cells(erow, 2) = ws.Range("D" & r).value End If Next r Next ws 

但是请注意，这将会为每个单词find一个匹配，第一个单词。 如果每个单词都可以重复多次，并且想要查找所有匹配，则需要进行一些修改。

Answer 2

查找命令可以更好地提供多行和多列。

 Option Explicit Private Sub CommandButton1_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 = "Sheet7" 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