excel - 在列中查找匹配项并从外部文件替换

Question

我使用这个工作得很好的 VBA 代码。它在外部 Excel 文件的 A 列中搜索 D 列中的所有术语，并将匹配项替换为找到的行中外部文件的 B 列的内容。例如:
如果 D5 与外部文件的 A11 匹配，则将外部文件中的 B11 写入 D5。
我现在正在尝试对其进行修改，以便它仍然在第 4 列中搜索外部文件的 A 列中的匹配项，但是对于找到的任何匹配项，将 E 列替换为外部文件的 B 列。所以:
如果 D5 与 A11 匹配，则将外部文件中的 B11 写入 E5。
好吧，我在替换循环中尝试了很多更改，但每次都会抛出错误。我想我没有使用正确的命令!

Private Sub CommandButton1_Click()
Dim NameListWB As Workbook, thisWb As Workbook
    Dim NameListWS As Worksheet, thisWs As Worksheet
    Dim i As Long, lRow As Long

    'This is the workbook from where code runs
    Set thisWb = ThisWorkbook
    Set thisWs = thisWb.Sheets("Sheet1")

    'External file
    Set NameListWB = Workbooks.Open("E:\Data.xlsx")
    Set NameListWS = NameListWB.Worksheets("Sheet1")

    With NameListWS
        'Detect end row in Col A of Data.xlsx
        lRow = .Range("A" & .Rows.Count).End(xlUp).Row

        'Loop though Column A
        For i = 1 To lRow
            '... and perform replace action
            thisWs.Columns(4).Replace What:=.Range("A" & i).Value, _
                                      Replacement:=.Range("B" & i).Value, _
                                      SearchOrder:=xlByColumns, _
                                      MatchCase:=False
        Next i
    End With
End Sub ```

Answer 1

未经测试:

Private Sub CommandButton1_Click()
    Dim NameListWB As Workbook
    Dim NameListWS As Worksheet, thisWs As Worksheet, n As Long
    Dim i As Long, arrList, arrD, rngD As Range

    Set thisWs = ThisWorkbook.Sheets("Sheet1") 'This is the workbook from where code runs
    'get an array from the column to be searched
    Set rngD = thisWs.Range("D1:D" & thisWs.Cells(Rows.Count, "D").End(xlUp).Row)
    arrD = rngD.Value
    
    'Open external file and get the terms and replacements as an array
    Set NameListWB = Workbooks.Open("E:\Data.xlsx")
    With NameListWB.Worksheets("Sheet1")
        arrList = .Range("A1:B" & .Cells(Rows.Count, "A").End(xlUp).Row).Value
    End With
 
    For n = 1 To UBound(arrD, 1)                                 'check each value from ColD
        For i = 1 To UBound(arrList, 1)                          'loop over the array of terms to search for
            If arrD(n, 1) = arrList(i, 1) Then                   'exact match ?
            'If InStr(1, arrD(n, 1), arr(i, 1)) > 0 Then         'partial match ?
                rngD.Cells(n).Offset(0, 1).Value = arrList(i, 2) 'populate value from ColB into ColE
                Exit For                                         'got a match so stop searching
            End If
        Next i
    Next n

End Sub