VBA-查找多个工作表中的所有匹配项

我正在处理一个宏，它将在整个工作簿中搜索各种代码。这些代码都是六位数。我希望搜索的代码输入到名为“Master”的工作表的A列中。如果在另一个工作表上找到的代码与主控中的代码匹配，则其工作表名称和单元格将粘贴在主控中匹配代码旁边的B列中。成功后，最终结果如下所示

下面发布的代码在某些情况下有效，但经常失败。偶尔会出现运行时错误，或者出现一条带有“400”的错误消息，而没有其他内容。出现这些错误时，宏将在所有列出的代码末尾的空白值的匹配项填充行。这显然不是预期的功能

对于上述错误，我感到不知所措。我想知道限制搜索范围是否有助于稳定。其他工作表上的所有代码都只能在A列中找到，因此像目前这样在所有列中搜索匹配项是非常浪费的。速度是次要的稳定性，但我首先要消除所有的故障点

Sub MasterFill()

Dim rngCell As Range
Dim rngCellLoc As Range
Dim ws As Worksheet
Dim lngLstRow As Long
Dim lngLstCol As Long
Dim strSearch As String

Sheets("Master").Select
lngLstRowLoc = Sheets("Master").UsedRange.Rows.Count
Application.ScreenUpdating = False
    For Each rngCellLoc In Range("A1:A" & lngLstRowLoc)
    i = 1
        For Each ws In Worksheets
            If ws.Name = "Master" Then GoTo SkipMe
                lngLstRow = ws.UsedRange.Rows.Count
                lngLstCol = ws.UsedRange.Columns.Count
                ws.Select
                    For Each rngCell In Range(Cells(2, 1), Cells(lngLstRow, lngLstCol))
                        If InStr(rngCell.Value, rngCellLoc) > 0 Then
                            If rngCellLoc.Offset(0, i).Value = "" Then
                                rngCellLoc.Offset(0, i).Value = ws.Name & " " & rngCell.Address
                                i = i + 1
                            End If
                        End If
                    Next
SkipMe:
        Next ws
    Next
    Application.ScreenUpdating = True
    Worksheets("Master").Activate
    MsgBox "All done!"
End Sub

---

在纠正逻辑的同时，看看这是否会加快事情的进程

Sub MasterFill()
    Dim addr As String, fndCell As Range
    Dim rngCellLoc As Range
    Dim ws As Worksheet

    Application.ScreenUpdating = False
    With Worksheets("Master")
        For Each rngCellLoc In .Range(.Cells(1, "A"), .Cells(.Rows.Count, "A").End(xlUp))
            For Each ws In Worksheets
                If LCase(ws.Name) <> "master" Then
                    With ws.Columns("A")
                        Set fndCell = .Find(what:=rngCellLoc.Value2, After:=.Cells(1), _
                                            LookIn:=xlFormulas, LookAt:=xlPart, _
                                            MatchCase:=False, SearchFormat:=False)
                        If Not fndCell Is Nothing Then
                            addr = fndCell.Address(0, 0)
                            Do
                                With rngCellLoc
                                    .Cells(1, .Parent.Columns.Count).End(xlToLeft).Offset(0, 1) = _
                                        Join(Array(ws.Name, fndCell.Address(0, 0)), Chr(32))
                                End With
                                Set fndCell = .FindNext(After:=fndCell)
                            Loop While addr <> fndCell.Address(0, 0)
                        End If
                    End With
                End If
            Next ws
        Next
        .Activate
    End With
    Application.ScreenUpdating = True
    MsgBox "All done!"
End Sub

Sub-MasterFill（）
Dim addr作为字符串，fndCell作为范围
变暗RNGCELLLLOC As范围
将ws设置为工作表
Application.ScreenUpdating=False
带工作表（“主控”）
对于.Range（.Cells（1，“A”）、.Cells（.Rows.Count，“A”）.End（xlUp））中的每个rngCellLoc
对于工作表中的每个ws
如果LCase（ws.Name）“master”，那么
使用ws.Columns（“A”）
设置fndCell=.Find（what:=rngCellLoc.Value2，After:=.Cells（1）_
LookIn:=xl公式，LookAt:=xlPart_
MatchCase:=False，SearchFormat:=False）
如果不是fndCell，那就什么都不是了
addr=fndCell.Address（0,0）
做
使用rngCellLoc
.Cells（1、.Parent.Columns.Count）.End（xlToLeft）.Offset（0,1）=_
Join（数组（ws.Name，fndCell.Address（0，0）），Chr（32））
以
设置fndCell=.FindNext（后面：=fndCell）
当addr fndCell.Address（0，0）时循环
如果结束
以
如果结束
下一个ws
下一个
.激活
以
Application.ScreenUpdating=True
MsgBox“全部完成！”
端接头

我使用了LookAt:=xlPart，这与您使用InStr作为标准逻辑保持一致；如果您只对整个单元格值感兴趣，请将其更改为LookAt:=xlWhole

我已将搜索范围限制为每个工作表中的A列

在添加新结果之前，不会清除以前的结果

您自己的错误是由于在Instr确定的任何其他字符串中发现零长度字符串（空白或vbNullString）的行为造成的

---

您确定要使用InStr作为标准逻辑吗？123将在012345内找到。除此之外，逐单元格搜索要比.Find/.FindNext慢得多。另外，请注意，不要使用，只需执行

如果ws.Name“Master”那么…

这太不可思议了，非常感谢！它几乎立即完成，并在我迄今为止测试的每个工作表中都成功。你的结束语也很有启发性。