VBA-查找多個工作表中的所有匹配項

Question

我正在使用一個宏，它將在整個工作簿中搜索各種代碼。 這些代碼都是六位數字。 我希望搜索的代碼輸入到稱為“主”的工作表的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

Answer 1

在更正邏輯時，看看這是否不能加速事情。

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

1. 我使用LookAt：= xlPart來保持您對標准邏輯使用InStr的方式。 如果只對整個單元格的值感興趣，請將其更改為LookAt：= xlWhole。
2. 我已將搜索范圍限制為每個工作表中的A列。
3. 添加新結果之前，不會清除以前的結果。
4. 您自己的錯誤是由於以下行為：由Instr確定時，在任何其他字符串中都發現了零長度的字符串（空白或vbNullString）。