Excel VBA 比較列

Question

我試圖在行之間比較同一張 excel 表上的兩個表。 以下是我想要實現的目標。 我已經解決了一些問題，但它不起作用，因為它刪除了行......

A   B   C   D       E             F         
E1  40  12   4    4/16/2017       E4  
E2  20  1    5    6/22/2016       E2  
E1  10  0    4    6/30/2017       E1  
E1  40  12   6    4/16/2017       E4  

Should turn into :

A   B   C   D       E             F             
E1  40  12  4;6   4/16/2017       E4  
E2  20  1   5     6/22/2016       E2  
E1  10  0   4     6/30/2017       E1  

任務1

如果 A 列匹配

如果 B 列匹配

如果列 C 匹配

如果 F 列匹配

然后

連接 D 行上的行並添加“;” 值之間並刪除連接的行。

我已經用這段代碼實現了這一點（只是添加了 F 的條件，但它不起作用），但沒有它它就不能正常工作，因為它可能不會將值存儲在字典中並且會跳轉行，所以它不會連接所有工作表中的值並跳過一些......

Sub TEMPLATE() 

Dim lngRow As Long For lngRow = ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row To 2 Step -1 

If StrComp(Range("B" & lngRow), Range("B" & lngRow - 1), vbTextCompare) = 0 And 

If StrComp(Range("A" & lngRow), Range("A" & lngRow - 1), vbTextCompare) = 0 And 

If StrComp(Range("C" & lngRow), Range("C" & lngRow - 1), vbTextCompare) = 0  And 

If StrComp(Range("F" & lngRow), Range("F" & lngRow - 1), vbTextCompare) = 0

Then 

If Range("D" & lngRow) <> "" Then 
Range("D" & lngRow - 1) = Range("D" & lngRow - 1) & ";" & Range("D" & lngRow) 

End If 

Rows(lngRow).Delete 
End If 
Next 
End Sub

任務 2

由於這是一個更新文件，我想比較舊文件中的每一行並進行更改，並在可能的情況下突出顯示它們。 比方說，如果我的 E1 隊列在 B 上添加了一個值，它將突出顯示 B 案例並添加該值。

我不知道該怎么做，我相信它應該在舊工作表和運行前一個宏的更新工作表之間循環。

謝謝大家幫助 ！

Answer 1

下面的代碼應該完成您的任務 1。它假定所有內容都在第一張表中。 它適用於您的示例，但我沒有進一步測試它，所以要小心。 但是，我認為它很清楚，因此您可以根據需要對其進行編輯。

任務1：

Sub filter_data()
    
    'Initialize iterator at row 1
    i = 0
    
    'Loop through data until no more rows
    Do While Sheets(1).Range("A1").Offset(i, 0).Value2 <> ""
        
        'Get values of row
        A_val_1 = Sheets(1).Range("A1").Offset(i, 0).Value2
        B_val_1 = Sheets(1).Range("A1").Offset(i, 1).Value2
        C_val_1 = Sheets(1).Range("A1").Offset(i, 2).Value2
        D_val_1 = Sheets(1).Range("A1").Offset(i, 3).Value2
        F_val_1 = Sheets(1).Range("A1").Offset(i, 5).Value2
        
        'Loop through data again to check if duplicates
        j = i 'Initialize iterator at row i
        Do While Sheets(1).Range("A1").Offset(j, 0).Value2 <> ""
            
            If j <> i Then 'Skip selected row
            
                'Get values of row
                A_val_2 = Sheets(1).Range("A1").Offset(j, 0).Value2
                B_val_2 = Sheets(1).Range("A1").Offset(j, 1).Value2
                C_val_2 = Sheets(1).Range("A1").Offset(j, 2).Value2
                D_val_2 = Sheets(1).Range("A1").Offset(j, 3).Value2
                F_val_2 = Sheets(1).Range("A1").Offset(j, 5).Value2
                
                'If conditions satisfied
                If A_val_1 = A_val_2 And B_val_1 = B_val_2 And C_val_1 = C_val_2 And F_val_1 = F_val_2 Then
                    
                    'Concatenate on D
                    Sheets(1).Range("A1").Offset(i, 3).Value2 = Sheets(1).Range("A1").Offset(i, 3).Value2 & ";" & D_val_2
                    
                    'Delete duplicate row
                    Sheets(1).Rows(j + 1).Delete
                    
                    'Decrement incrementor by 1 to make up for deleted row
                    j = j - 1

                End If
            End If
            
        j = j + 1 'increment
        Loop
        
    i = i + 1 'increment
    Loop
    
End Sub

也許（？）我稍后會回到任務 2，但這應該非常簡單——您只需要遍歷所有單元格，比較一個亮點。

編輯：據我了解，下面的任務 2。 它只檢查新工作表中的差異，突出顯示與舊工作表單元格的差異，並將舊值附加到新值的左側（可以更改）。 同樣，它適用於您的示例。

任務 2：

Sub compare_data()

    'Initialize sheets to compare; only cells on new sheet will be highlighted
    old_sheet_idx = 1 'index of old sheet
    new_sheet_idx = 2 'index of updated sheet
    
    'Get number of populated rows & column in new sheet
    new_sheet_rows = Range(Sheets(new_sheet_idx).Range("A1"), Sheets(new_sheet_idx).Range("A1").End(xlDown)).Count
    new_sheet_cols = Range(Sheets(new_sheet_idx).Range("A1"), Sheets(new_sheet_idx).Range("A1").End(xlToRight)).Count
    
    'Clear all formats in new sheet
    Sheets(new_sheet_idx).Cells.ClearFormats
    
    'Loop through all rows of new sheet
    For i = 1 To new_sheet_rows
    
        'Loop through all cells of the row
        For j = 1 To new_sheet_cols
        
            'Get cell value
            new_cell = Sheets(new_sheet_idx).Range("A" & i).Offset(0, j - 1).Value2
            old_cell = Sheets(old_sheet_idx).Range("A" & i).Offset(0, j - 1).Value2
            
            'Compare
            If new_cell <> old_cell Then
                Sheets(new_sheet_idx).Range("A" & i).Offset(0, j - 1).Interior.ColorIndex = 6 'highlight yellow
                Sheets(new_sheet_idx).Range("A" & i).Offset(0, j - 1).Value2 = old_cell & ";" & new_cell 'concatenate old value;new value
            End If
            
        Next j
    Next i

End Sub