Excel 查找并用多个新值替换单个匹配值

Question

我有 2 张 excel 表，我想在其中查找和替换值，但是我希望多个替换值代替一个匹配值。

Sheet 1:                              Sheet 2:

Match Value                           Match Value   New Value
28045000                              28045000      28051560
39162010                              28045000      28056549
39269000                              39162010      39596000

工作表 1 中的所有匹配值都是唯一的，而工作表 2 中的匹配值可能有重复，因为它们对应于多个新值。因此，如果工作表 1 和工作表 2 中的匹配值相同，那么我想将工作表 1 中的匹配值替换为与匹配值对应的所有新值。替换后的表 1 应如下所示：

Sheet 1:                        

Match Value                           
28051560 
28056549                           
39596000                              
39269000                              

我们可以看到，28045000 在 2 个单独的单元格中被 2 个值替换，即 28051560 和 28056549，而 39162010 被 39596000 替换，而在工作表 2 中没有匹配值的 39269000 保持不变。

我通常会手动执行此操作，但大约有 30,000 行数据，其中一些具有超过 10 个与单个匹配值匹配的值。我有以下代码，但是，这并没有正确地用所有新值替换匹配值。有没有办法让 Excel 搜索两个工作表的整个范围并自动进行适当的更改？

Sub multiFindNReplace()
    Dim myList, myRange
    Set myList = Sheets("sheet 1").Range("A1:A5000") 
    Set myRange = Sheets("sheet2").Range("A1:A5000")
    For Each cel In myList.Columns(1).Cells
        myRange.Replace what:=cel.Value, replacement:=cel.Offset(0, 1).Value
    Next cel
End Sub

Answer 1

我会这样做：

宏只是循环遍历第一张纸并将其与第二张纸进行比较。如果匹配，则替换第一个值，添加 c+1 并继续搜索。因为原始值被替换了，所以原始值存储在 d 中，如果找到第二个匹配项，它不会因为 c+1 而替换它，它转到 else 子句，插入一行并将值放入新行。像这样循环遍历 sheet1 上的整个列。

PS：希望你能理解，我没有那么多时间，稍后会编辑以提高可读性。

更新：

所以我们又来了，我添加了 maxrow 计数器并对其进行了注释以便于理解。

更新 2：

现在使用 While-Loop，因为 for 循环不会重新调整限制更改

Sub CompareLoop()

'Iterator Worksheet 1, is the counter for the ws1 column
Dim iWS1 As Integer
'Iterator Worksheet 2, is the counter for the ws1 column
Dim iWS2 As Integer
'Switch New Row, is the switch if the next value need a new row
Dim sNR As Integer
'Maximal Row Count, need to be extend when new rows are added
Dim MaxRows As Integer
'valueHolder, is the holder for the orginal value, the orginal value might be replaced on the sheet
Dim valueHolder As Long

'Worksheet1
Dim ws1 As Worksheet
'Worlsheet2
Dim ws2 As Worksheet

Set ws1 = ActiveWorkbook.Worksheets("table1")
Set ws2 = ActiveWorkbook.Worksheets("table2")

'Set iWS1 to the first row
iWS1 = 1
'Get MaxRows
MaxRows = ws1.Cells(Rows.Count, 1).End(xlUp).Row

'Loop through the Rows on WS1 setting switch to 0 and store the value     from the ws1 row in the holder
While iWS1 <= MaxRows
sNR = 0
valueHolder = ws1.Cells(iWS1, 1).Value

'Loop through the Rows on WS2, searching for a value that match with the value from ws1
For iWS2 = 1 To ws2.Cells(Rows.Count, 1).End(xlUp).Row
    'When it matches, then look if there was already a match with the value, if not replace it on the ws1 and increase the sNr to 1
    If valueHolder = ws2.Cells(iWS2, 1).Value Then
        If (sNR < 1) Then
            ws1.Cells(iWS1, 1).Value = ws2.Cells(iWS2, 2).Value
            sNR = sNR + 1
        'When the sNR is already > 0, increase the Iterator for the ws1 that he will point on the new line
        'increase the maxrows because we got one more soon, finally insert the new row and store the value from ws2 in it
        Else
            iWS1 = iWS1 + 1
            MaxRows = MaxRows + 1
            Range(ws1.Cells(iWS1, 1), ws1.Cells(iWS1, 1)).EntireRow.Insert
            ws1.Cells(iWS1, 1).Value = ws2.Cells(iWS2, 2)
        End If
    End If
Next iWS2
iWS1 = iWS1 + 1
Wend

End Sub

Answer 2

假设从 A 开始的列是连续的并且在工作表 1、B2 中被标记并向下复制以适应：

=IF(ISERROR(MATCH(A2,'Sheet 2'!A:A,0)),A2,"")  

复制包含工作表 1 列 B 中的所有值的范围并选择性粘贴，工作表 2 列 B 中最后一个条目下方的值。

将工作表 2 的 B 列复制到工作表 1 的 A1 并过滤以删除 A 列中的空白。删除工作表 1 的 B 列。