首页 文章

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

提问于
浏览
0

我试图在同一工作簿中的2个不同工作表中的2列之间进行部分比较 . 例如:Sheet2的B列包含“Rs ID”,A列包含“临床意义”,而在Sheet1中有2列A和B以及相同的 Headers .

如果Sheet2的B列中有一个 partial match ,其中Sheet1的列B,我希望我的VBA代码将Sheet A中的单元格从Sheet2复制到Sheet1中的A列中的相同单元格 .

Sheet 1 Sheet 2

这是我的代码 . 它运行完美但它似乎没有捕获任何数据,因为表2 _1003947中的列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

1 回答

  • 0

    请尝试以下代码 . 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
    

相关问题