Excel VBA 查找功能 - 区分多个结果

Question

我有一个包含两个工作表的工作簿。在一个工作表上，我有一列以逗号分隔的值作为文本（电子元件参考）。例如。 C1 = "R1, R2, R3, ..., R125" ; C2 = "C1, C2, C3, ..." ; C3 = "TR1, TR2, TR3, ..." ; C4 = "IC1, IC2, IC3 ..."

我创建了下面的代码来搜索 Sheet2 上的 column C 以查找特定值（例如“R1”），当它找到该值时，获取该部分同一行中另一列的编号。例如。如果在单元格C12 中找到R1，它将返回单元格D12. 中的部件号

当 C 列 仅包含逗号分隔值的唯一列表时，我在下面编写的代码运行良好，但是当存在重复时我遇到了问题。例如。对于上面的示例，如果R1 在单元格C1 中，而TR1 在单元格C3 中，那么当我尝试查找R1 时，有时它只能在单元格C3 中找到它，因此返回不正确TR1 的零件号，而不是 R1。我对 Cxx 和 ICxx 引用有同样的问题。

不知何故，我需要修改代码，以便如果我只搜索 R1 并且在特定单元格中找到它，那么我需要检查 R1 子字符串是否立即包含“T”在它前面（“TR1”），如果是，请继续搜索。

我可能还需要检查找到的R1 后面是否有逗号（即“R1”），这样我也不会遇到问题，例如R1 在一个单元格中，R11 在另一个具有不同部件号的单元格中。

我真的不知道如何修改我的代码来解决这个问题？我是否需要将找到正匹配的每个单元格转换为字符串，然后进行某种子字符串 - 内 - 字符串搜索？

Private Sub Pop_Rel_Click()

    Dim W1 As Workbook
    Set W1 = ActiveWorkbook       
    
    W1.Sheets("Sheet 1").Select
                
    'Select All non-empty cells in Column B (Ref-des) Row 11 onwards...
    
    ActiveSheet.Range("B11:B10000").SpecialCells(xlCellTypeConstants).Select
                                                       
    'Loop through ref-des selection...
    
    Dim cel As Range
    Dim selectedRange As Range
    Dim foundItem As Range
    Set selectedRange = Application.Selection

    For Each cel In selectedRange.Cells
        '...search for corresponding part number from sheet 2
        
        Set foundItem = W1.Sheets("Sheet 2").Range("C11:C1000").Find(What:=cel.Value, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
        
        If foundItem Is Nothing Then
            Debug.Print cel.Address, cel.Value, "NOT FOUND"
        Else
            'find P/N from sheet 2...
            '...and insert into column C of sheet 1
            cel.Offset(0, 1) = foundItem.Offset(0, -1).Value
             
            Debug.Print cel.Address, cel.Value, foundItem.Address, foundItem.Offset(0, -1).Value, foundItem.Offset(0, 1).Value, foundItem.Offset(0, 2).Value
        End If

        'Debug.Print cel.Address, cel.Value,
    Next cel
                    
    'End loop
        
    MsgBox ("Populated in Worksheet 1:" & Chr(10) & "1. Part Numbers")

End Sub

Answer 1

如果您找到匹配的Split，则通过逗号将字符串放入数组并检查数组的每个元素是否完全匹配。如果未找到匹配项，请使用 FindNext 继续搜索。

Option Explicit

Private Sub Pop_Rel_Click()
    
    Const HDR = 10 ' 10 rows header
    Dim Wb As Workbook, ws1 As Worksheet, ws2 As Worksheet
   
    Dim cel As Range, rngB As Range, rngSearch As Range, rngFound As Range
    Dim ar As Variant, s As String
    Dim i As Long, iLastRow As Long
    Dim sFirstFind As String, bMatch As Boolean

    Set Wb = ActiveWorkbook
    Set ws1 = Wb.Sheets("Sheet 1")
    Set ws2 = Wb.Sheets("Sheet 2")
                    
    'Select All non-empty cells in Column B (Ref-des) Row 11 onwards...
    iLastRow = ws1.Range("B" & Rows.Count).End(xlUp).Row
    Set rngB = ws1.Range("B" & HDR & ":B" & iLastRow).SpecialCells(xlCellTypeConstants)
   
    iLastRow = ws2.Range("C" & Rows.Count).End(xlUp).Row
    Set rngSearch = ws2.Range("C" & HDR & ":C" & iLastRow)

    For Each cel In rngB
        
        '...search for corresponding part number from sheet 2
        Set rngFound = rngSearch.Find(What:=cel.Value, _
           LookIn:=xlValues, LookAt:=xlPart, _
           SearchOrder:=xlByRows, _
           SearchDirection:=xlNext, _
           MatchCase:=False, SearchFormat:=False)
        
        bMatch = False
        If Not rngFound Is Nothing Then
               
            ' split string by comma into array
            bMatch = False
            sFirstFind = rngFound.Address
            
            Do
                ar = Split(rngFound.Value, ",")
                For i = 0 To UBound(ar)
                    If Trim(ar(i)) = cel Then
                     ' copy
                        cel.Offset(0, 1) = rngFound.Offset(0, 1).Value
                        bMatch = True
                        Exit For
                    End If
                Next
                Set rngFound = rngSearch.FindNext(rngFound)

            Loop While Not rngFound Is Nothing And bMatch = False _
                       And rngFound.Address <> sFirstFind
        End If
        ' no match
        If bMatch = False Then
            cel.Offset(0, 1) = "not found"
            Debug.Print "NOT FOUND", cel.Address, cel.Value
        End If

    Next cel
    MsgBox ("Populated in Worksheet 1:" & Chr(10) & "1. Part Numbers")
    
End Sub