VBA。根据来自另一个表格的匹配替换表格单元格内容，或者如果未找到匹配则删除整行

Question

我正在尝试使以下工作： 单独的工作表中有两个表。我希望它检查工作表 2 列 B 中的每个单元格，并从工作表 1 列 A 中找到匹配项。如果找到匹配项，则将工作表 2 列 B 中的数据替换为工作表 1 列 B 的匹配行中的数据。 如果从 worksheet1 列 A 中找不到匹配项，则删除 worksheet2 列 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

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

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