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

我正在研究一个macros，它将search整个工作簿中的各种代码。 这些代码都是六位数字。 我想要search的代码被input到名为“主”的表单的A列中。 如果在另一张纸上find的代码与主人中的一张相匹配，则它的工作表名称和单元格将被粘贴在主人匹配旁边的B列中。 如果成功，最终结果如下所示。

下面的代码在某些情况下工作，但经常失败。 偶尔会出现运行时错误，或者出现错误信息“400”而没有其他的东西。 发生这些错误时，macros在所有列出的代码的末尾填充一行，并填充空白值。 这显然不是预期的function。

我对上述错误感到不知所措。 我想知道如果限制search范围将有助于稳定。 其他工作表中的所有代码只能在A列中find，因此在当前所有列中search匹配是非常浪费的。 速度是次要的稳定，但是，我首先要消除所有的失败点。

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. 我已经将search范围限制在每​​个工作表的A列中。
3. 在添加新结果之前，先前的结果不会被清除。
4. 你自己的错误是由于在由Instr确定的任何其他string中find零长度的string（空白或vbNullString）的行为。