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

时间:2016-07-26 14:04:42

标签: excel excel-vba conditional vba

我有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

2 个答案:

答案 0 :(得分:0)

我会这样做:

宏只是遍历第一张纸并将其与第二张纸进行比较。如果匹配,则替换第一个中的值,添加c + 1并继续搜索。因为原始值被替换,所以orignal值存储在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

答案 1 :(得分:0)

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

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

复制范围包含工作表1 B列中的所有值和工作表2 B列中最后一项下面的粘贴特殊值。

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