Question

有这个代码的问题，如果找到多个匹配，不知道如何更新它以将结果连接到一个单元格？它在我缩小的测试文件中工作得很好，但是当我尝试在我的真实文件中使用它时（它出现了“运行时错误'13'错误：”类型不匹配...

我发现它一定是因为它发现了超过一个Part＃匹配，并且不知道如何回应。最终，它需要将所有发现集中到一个单元格中（它应该粘贴其发现的单个单元格）。

**' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
**'THE GOAL**
**' >>>> IF Worksheet1 "BOM Worksheet" "P" matches Worksheet2 "INDEX" "A",**
**' >>>> then copy adjacent data from Worksheet2 "INDEX" "B" into Worksheet1 "BOM Worksheet" "S"**
**' +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++****

视觉示例： 如果你在书中查找“dog”这个词，你需要收集的相邻数据就是他的名字：“FIDO”，你会记录你找到的事实：“FIDO”

你将向下移动到下一行并查找单词“cat”，相邻的数据名称是：“TOM”，在第7页上找到你记录你找到的事实：“TOM”

但等待!!它在第12页“KITTY”再次发现“猫”，并再次在第16页！ “BOB” * 我需要代码来记录“cat”（“TOM”，“KITTY”，“BOB”） *在原始单元格中的所有发现，它应该粘贴该发现，如果它只是一个发现。结果如下所示："TOM","KITTY","BOB"

如果找到倍数，如何修复此代码以将所有发现记录到一个单元格中？

Sub MOD_50_LookupCopyPasteDiffSheet()
    Dim rng1 As Range, c1 As Range, rng2 As Range, c2 As Range
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim lnLastRow1 As Long, lnLastRow2 As Long

     'Create an object for each worksheet:
    Set ws1 = Worksheets("BOM Worksheet")
    Set ws2 = Worksheets("INDEX")

     'Get the row number of the last cell containing data in each sheet:
    lnLastRow1 = ws1.Cells(ws1.Cells.Rows.Count, "P").End(xlUp).Row
    lnLastRow2 = ws2.Cells(ws2.Cells.Rows.Count, "A").End(xlUp).Row

     'Create range objects for the two columns to be compared:
    Set rng1 = ws1.Range("P2:P" & lnLastRow1)
    Set rng2 = ws2.Range("A2:A" & lnLastRow2)

     'Loop through each cell in col A in sheet 2:
    For Each c2 In rng2

         'Check if the cell is not blank:
        If c2.Value <> "" Then

             'Loop through each cell in col B in sheet 1:
            For Each c1 In rng1

                 'Test if cells match: <<<<<<< THIS IS WHERE THE CODE ERRORS OUT
                If c1.Value = c2.Value Then

                     'Copy value from sheet 2 to sheet 1:
                    c1.Offset(0, 2).Value = c2.Offset(0, 1).Value

                     'Move on to next cell in sheet 2:
                    Exit For '(exits the "For Each c1 In rng1" loop)

                End If
            Next c1
        End If
    Next c2
End Sub

Answer 1

我的两分钱，我在类型不匹配的情况下添加了Cstr（），并为重复部分的字符串连接添加了“if block”：

 'Check if the cell is not blank:
If CStr(c2.Value) <> "" Then
     'Loop through each cell in col B in sheet 1:
    For Each c1 In rng1

         'Test if cells match: <<<<<<< THIS IS WHERE THE CODE ERRORS OUT
        If Cstr(c1.Value) = Cstr(c2.Value) Then

             'Copy value from sheet 2 to sheet 1:
            If Cstr(c1.Offset(0, 2).Value) <> "" Then
                c1.Offset(0, 2).Value = CStr(c1.Offset(0, 2).Value) & ", " & CStr(c2.Offset(0, 1).Value)
            Else
                c1.Offset(0, 2).Value = CStr(c2.Offset(0, 1).Value)
            End If
             'Move on to next cell in sheet 2:
            Exit For '(exits the "For Each c1 In rng1" loop)

        End If
    Next c1
End If

如果找到多个匹配，如何将多个发现连接到单个单元格中

1 个答案: