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

我有2个Excel表，我想查找和替换值，但是我希望有多个替换值取一个匹配值的点。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个值，28051560和2个独立的细胞28056549更换，而39162010是由39596000替代，而39269000在表2中没有匹配值，保持不变。

我通常会手动执行此操作，但大约有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

来源

2016-07-26 mike

必须在应用VBA这个？ – pnuts

@pnuts没有不一定，有没有不同的方式来做到这一点，你可以建议？ – mike

@pnuts可以详细阐述一下更多细节中的匹配部分吗？ – mike

我会做这样的：

宏只是循环通过第一片并将其与第二片进行比较。如果匹配，则替换第一个值，然后添加c + 1并继续搜索。因为原始值被替换，那么原始值存储在d中，如果它发现第二个匹配，它不会因为c + 1而替换它，它会转到else子句，插入一行并将值放入新排。像这样，它循环遍历sheet1上的整个列。 PS：我希望你能理解它，我没有那么多时间，为了更好的可读性，稍后再编辑。

更新：

所以又来了，我加了MaxRow的计数器和overcomment它一个容易理解。

更新2：

与while循环

现在由于for循环不regconize极限改变

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

来源

2016-07-26 15:52:12 thentt

这就是我要找的。我对代码的一个问题是我需要多次运行代码，因为它只执行一个值，然后停止执行。例如，如果我有1500，与1501,1502和1503匹配，而我也有1700匹配1701和1702，我需要运行代码两次才能工作。这成为问题，因为我的工作表中有成千上万的数据，并且我不知道执行代码的次数。有没有办法编辑这段代码，以便它可以在宏的一次运行中执行所有代码？ – mike

我想这是来自我犯的一个错误。它得到了row.count，后来又增加了一些行，但是仍然停留在同一行。我将更正 – thentt

我已尝试更新副本，但我仍然遇到与上述相同的问题。任何你认为它发生的原因？ – mike

假设柱洗脱，开始是连续的和被标记，在表1 ，B2和向下复制到花色：

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

含有选自表1列B的所有值

复制范围和粘贴特殊，下面最后值条目表2列B.

复制工作表2列B为表1和过滤器的A1，除去在A列中的空白删除工作表1列B.

来源

2016-07-26 18:25:14 pnuts

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

回答

相关问题