VBA.根据另一个表中的匹配项替换表格单元格内容，如果未找到匹配项，则删除整行

Question

我正在尝试使以下内容正常工作： 单独的工作表中有两个表。我希望它检查工作表2列B中的每个单元格，并从工作表1列A中找到匹配项。如果找到匹配项，则将工作表 2 列 B 中的数据替换为工作表 1 列 B 的匹配行中的数据。 如果从工作表 1 列 A 中找不到匹配项，则删除工作表 2 列 B 中的整行。

Sub match_repl_del()
Dim r1 As Long, rfound, vfound
Dim w1, w2, v As Long
Set w1 = Sheets(3) ' data sheet
Set w2 = Sheets(2) ' target sheet
r1 = 2 'data starting from row 2
Do While Not IsEmpty(w1.Cells(r1, 1))
v = w1.Cells(r1, 1)
rfound = Application.Match(v, w2.Columns(2), 0) ' look for value
If Not IsError(rfound) Then ' found it?
vfound = w2.Cells(rfound, 2)
If w1.Cells(r1, 2) <> vfound Then ' if value does not match sheet1 column b
w2.Cells(rfound, 2) = w1.Cells(r1, 2) ' update based on origin sheet
lastC = w2.Cells(rfound, 1).End(xlToRight).Column
w2.Range(w2.Cells(rfound, 1), w2.Cells(rfound, lastC)).Interior.ColorIndex = 5
Else ' delete entire row on sheet2 if match is not found
w2.Rows(r1).EntireRow.Delete
End If
End If
r1 = r1 + 1
Loop
End Sub

Answer 1

试试这个笏，它对我有用：

Option Explicit
Sub test()

' Active workbook
Dim wb As Workbook
Set wb = ThisWorkbook
Dim i As Long
Dim j As Long
'*******************************************
'Adapt this vars

'define your sheets
Dim ws_1 As Worksheet
Dim ws_2 As Worksheet
Set ws_1 = wb.Sheets("Sheet1") 'find a match in worksheet1 column A
Set ws_2 = wb.Sheets("sheet2") 'cell in worksheet2 column B
'definie the last Rows
Dim lastRow_ws1 As Long
Dim lastRow_ws2 As Long
lastRow_ws1 = ws_1.Range("A" & Rows.Count).End(xlUp).Row   'if you need, adjust column to find last row
lastRow_ws2 = ws_2.Range("B" & Rows.Count).End(xlUp).Row  'if you need, adjust column to find last row
'*******************************************

For i = lastRow_ws2 To 2 Step -1
For j = 1 To lastRow_ws1
Dim keySearch As String
Dim keyFind As String
keySearch = ws_2.Cells(i, 2).Value
keyFind = ws_1.Cells(j, 1).Value

If keySearch = keyFind Then
'MsgBox keySearch & " " & keyFind & " yes"
ws_2.Cells(i, 2).Value = ws_1.Cells(j, 2).Value
GoTo next_i
End If
Next j
ws_2.Rows(i).EntireRow.Delete
next_i:
Next i
End Sub