Question

我正在尝试对同一工作簿中2个不同工作表中的2列进行部分比较。例如：Sheet2的B列包含“Rs ID”，A列包含“临床意义”，而在Sheet1中有2列A＆amp; B以及相同的标题。

如果Sheet2的B列中有部分匹配，而Sheet1的列B，我希望我的VBA代码将列A中的单元格从Sheet2复制到A列中的相同单元格在Sheet1中。

这是我的代码。它运行完美，但它似乎没有捕获任何数据，因为表2中的列B 与列A不完全相同。可能是我错误编码.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)
 If cfind Is Nothing Then GoTo line1
  y = cfind.Offset(0, -1).Value
  End With
   c2.Offset(0, -1) = y
   line1:
   Next c2
End With

End Sub

Answer 1

请尝试以下代码。 LookIn:=xlValues是必不可少的缺失部分。

PS：使用Goto通常被认为是不好的做法。我使用If (Not (cfind Is Nothing))消除了它。

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

两列之间的部分匹配并复制相应的单元格VBA

1 个答案: