首页 文章

匹配来自不同列的部分单元格值并进行复制

提问于
浏览 次
1

我试图在同一工作簿中的2个不同工作表中的2列之间进行部分比较 .

例如：Sheet2的 Column B 包含 Rs ID （所有数字）， Column A 包含 Clinical Significance ，在Sheet1中有2列 A ＆ B （包含字符串和数字）以及相同的 Headers .

如果 Sheet2 的 Column B 与 Column B 的 Sheet1 存在部分匹配，我希望我的VBA代码将 Column A 中的单元格从 Sheet2 复制到 Sheet1 中 Column A 中的同一单元格 .

Sheet1 ：

sheet1

Sheet2 ：

sheet2

这是我的代码 . 它运行完美但它似乎没有捕获任何数据，因为 sheet2 中的 Column B 与 Column A 不完全相同 . 可能是我错误地使用了 lookat:=xlPart 吗？

Sub test()
    Dim rng2 As Range, c2 As Range, cfind As Range
    Dim x, y
    With Worksheets("sheet1")
        Set rng2 = .Range(.Range("B2"), .Range("B2").End(xlDown))
        For Each c2 In rng2
            x = c2.Value
            With Worksheets("sheet2").Columns("B:B")
                On Error Resume Next
                Set cfind = .Cells.Find(what:=x, lookat:=xlPart, LookIn:=xlValues)
                If (Not (cfind Is Nothing)) Then
                    y = cfind.Offset(0, -1).Value
                    c2.Offset(0, -1) = y
                End If
            End With
        Next c2
    End With
End Sub
excel vba excel-vba

1 回答

  • 0

    你是（我相信）从第一张纸中寻找 Value ，在第二张纸内，而它应该是另一种方式;-) .

    试试这个，对我有用你提供的数据 . 我使用略有不同的方法，但总体思路保持不变 .

    Option Explicit


Sub test()

  'declaration
  Dim ws1 As Worksheet, ws2 As Worksheet
  Dim c1 As Range, c2 As Range, rng1 As Range, rng2 As Range, cfind As Range

  'set worksheets
  Set ws1 = ActiveWorkbook.Sheets(1)
  Set ws2 = ActiveWorkbook.Sheets(2)

  'define ranges to look in/for
  With ws1
    Set rng1 = .Range(.Cells(2, 2), .Cells(.Cells(Rows.Count, 2).End(xlUp).Row, 2))
  End With
  With ws2
    Set rng2 = .Range(.Cells(2, 2), .Cells(.Cells(Rows.Count, 2).End(xlUp).Row, 2))
  End With

  'loop through the values in sheet 1
  For Each c1 In rng1
    'loop through the values in sheets 2
    For Each c2 In rng2
      On Error Resume Next
      'look for the value from sheet 2, in sheet 1
      Set cfind = c1.Find(what:=c2.Value, lookat:=xlPart, LookIn:=xlValues)
      'is a partial match found? then copy the value from column sheet2-colA from c2 to sheet1-colA for c1
      If (Not (cfind Is Nothing)) Then
          c1.Offset(0, -1).Value = c2.Offset(0, -1).Value
      End If
      'emtpy the found range
      Set cfind = Nothing
    Next c2
  Next c1

'SUCCESS!!

End Sub

    它总是循环遍历rng2中的所有值！因此，如果在rng2中的多个单元格中找到来自c1的值，则它会使用最新的查找覆盖上一个匹配项！

    回复于

相关问题