我怎样才能修复我的循环，以便找到所有匹配项？

Question

我的代码就是这样做的。它在我当前的工作表中搜索单词：“KENNFELD”。然后它将变量标签设置为“KENNFELD”右侧的单元格。现在我想在我的整个工作簿中找到变量标签的匹配项，不包括我当前所在的那个，因为那是我首先得到它们的地方。

问题是，这适用于找到的第一个标签，但不适用于其他标签，而且我知道必须再匹配 6 个。我相信我的问题在循环中，但我找不到它。有人有想法吗？

Dim helpc As Range
Dim label As Range
Dim firstAddress As String
Dim foundCell As Range

With Sheets("C7BB2HD3IINA_NRM_X302")
Set helpc = .Cells.Find(what:="KENNFELD", MatchCase:=True)
Set label = helpc.Offset(0, 1) ' assign the value of the cell to label
If Not helpc Is Nothing Then
    firstAddress = helpc.Address
    Do
        For Each ws In ThisWorkbook.Sheets
            If ws.Name <> "C7BB2HD3IINA_NRM_X302" Then
                Set foundCell = ws.Cells.Find(what:=label.Value, LookIn:=xlValues, LookAt:=xlWhole, _
                                              MatchCase:=True)
                If Not foundCell Is Nothing Then
                    MsgBox "Label " & label.Value & " found on sheet " & ws.Name
                End If
            End If
        Next ws
        Set helpc = .Cells.FindNext(helpc)
    Loop While Not helpc Is Nothing And helpc.Address <> firstAddress
End If
End With

Answer 1

查找找到的值

Option Explicit

Sub FindLabels()

    Const DST_NAME As String = "C7BB2HD3IINA_NRM_X302"
    Const DST_SEARCH_STRING As String = "KENNFELD"
    Const DST_COLUMN_OFFSET As Long = 1
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim dws As Worksheet: Set dws = wb.Sheets(DST_NAME)
    If dws.AutoFilterMode Then dws.AutoFilterMode = False
    Dim drg As Range: Set drg = dws.UsedRange
    Dim dlCell As Range
    Set dlCell = drg.Cells(drg.Rows.Count, drg.Columns.Count)
    
    Dim dCell As Range: Set dCell = drg.Find( _
        DST_SEARCH_STRING, dlCell, xlFormulas, xlWhole, xlByRows, , True)
    
    If dCell Is Nothing Then
        MsgBox "Could not find """ & DST_SEARCH_STRING & """ in worksheet """ _
            & DST_NAME & """ of workbook """ & wb.Name & """.", vbCritical
        Exit Sub
    End If
    
    Dim durg As Range: Set durg = dCell.Offset(, DST_COLUMN_OFFSET)
    Dim dFirstAddress As String: dFirstAddress = dCell.Address
    
    Do
        Set durg = Union(durg, dCell.Offset(, DST_COLUMN_OFFSET))
        Set dCell = drg.FindNext(dCell)
    Loop Until dCell.Address = dFirstAddress
    
    Dim sws As Worksheet, srg As Range, slCell As Range, sCell As Range
    Dim sFirstAddress As String, Label
    
    For Each sws In wb.Worksheets
        If StrComp(sws.Name, DST_NAME, vbTextCompare) <> 0 Then
            If sws.AutoFilterMode Then sws.AutoFilterMode = False
            Set srg = sws.UsedRange
            Set slCell = srg.Cells(srg.Rows.Count, srg.Columns.Count)
            For Each dCell In durg.Cells
                Label = dCell.Value
                Set sCell = srg.Find( _
                    Label, slCell, xlFormulas, xlWhole, xlByRows, , True)
                If Not sCell Is Nothing Then ' label found in current worksheet
                    sFirstAddress = sCell.Address
                    Do
                        MsgBox "Label """ & CStr(Label) & """ found in Cell " _
                            & """" & sCell.Address(0, 0) & """ of worksheet " _
                            & """" & sws.Name & """.", vbInformation
                        Set sCell = srg.FindNext(sCell)
                    Loop Until sCell.Address = sFirstAddress
                'Else ' label not found in current worksheet; do nothing
                End If
            Next dCell
        'Else ' it's the destination worksheet; do nothing
        End If
    Next sws
        
End Sub