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

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

例如：Sheet2的Column B包含Rs ID （所有数字），而Column A包含Clinical Significance ，在Sheet1中有2列A和B （包含string和数字）以及相同的标题。

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

Sheet1 ：

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 

Answer 1

你（我相信）从第一张表单中寻找价值，而在第二张表格中，它应该是另一种方式;-)。

试试这个，用你提供的数据为我工作。 我使用了一个稍微不同的方法，但总体思路保持不变。

 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中的多个单元格中findc1的值，那么它将用最新的查找覆盖以前的匹配项！