VBA比較兩個excel行和刪除相似的單元格

Question

我想做一個excel代碼，將比較相同的工作表的第1行和第2行的使用範圍，並刪除任何相似的單元格，並將其餘（唯一值）單元格第1行從A1開始。

例如）如果第1行中包含這些值（逗號inidicate DIFF細胞）：A，B，C 和行2含有：A，B，C，d，E

我想要的代碼進行比較的兩行，最後一行是：d，e（在列A和B中），代碼完成後。任何幫助，將不勝感激。

即時通訊新的VBA，所以即時通訊有麻煩的一些語法，我將不勝感激，如果一些專業人員可以幫助我。

1. 獲取第1行和第2行的已用列數作爲整數。例如）maxCol1 = 3，maxCol2 = 5

2. 創建一個for循環，從i = 1到maxCol2並比較第1行到第2行。如果它們相等，則使它們都爲「」，如果有東西在第2行但不在第1行，將該值設置爲單元格A1。

基本上只需要設置步驟1的幫助。

Answer 1

隨着評論中發佈的鏈接的幫助，我想出了它！感謝那些幫助過的人。該代碼比較第1行中的第2行並刪除任何相似的單元格值，並將唯一值發佈到第1行，並將其發佈到新的工作表中。

Sub CompareAndDelete() 
'This code will compare the rows of each sheet and delete any old alerts that have already been emailed out 
' it will then call SaveFile IF new alerts have been found 

Dim row1() As Variant, row2() As Variant, newRow As Variant 
Dim coll As Collection 
Dim i As Long 
Dim maxCol1 As Integer 
Dim maxCol2 As Integer 

'Find max number of columns for old and new alert 
With ActiveSheet 
    maxCol1 = .Cells(1, .Columns.Count).End(xlToLeft).Column 
    maxCol2 = .Cells(2, .Columns.Count).End(xlToLeft).Column 
End With 

'Redimensionalize arrays 
ReDim row1(0 To (maxCol1 - 1)) 
ReDim row2(0 To (maxCol2 - 1)) 

'Assign row1/row2 string values into arrays 
For r = 0 To (maxCol1 - 1) 
    row1(r) = Cells(1, r + 1).Value 
Next 

For s = 0 To (maxCol2 - 1) 
    row2(s) = Cells(2, s + 1).Value 
Next 

ReDim newRow(LBound(row1) To Abs(UBound(row2) - UBound(row1)) - 1) 

'Create a collection to load all row1/row2 values into 
Set coll = New Collection 

'Empty Collection for each run through 
Set coll = Nothing 

'Set collection to New before using 
Set coll = New Collection 



For i = LBound(row1) To (UBound(row1)) 
    coll.Add row1(i), row1(i) 
Next i 

For i = LBound(row2) To (UBound(row2)) 
    On Error Resume Next 
    coll.Add row2(i), row2(i) 
    If Err.Number <> 0 Then 
     coll.Remove row2(i) 
    End If 
    On Error GoTo 0 
Next i 

'Copy Row 2 and Paste it to Row 1 

ActiveWorkbook.ActiveSheet.Rows(2).Copy 
Range("A1").Select 
ActiveSheet.Paste 

'Now values are stored in collection, delete row 2 
'Rows(2).EntireRow.ClearContents 

'Paste only the new alerts onto a new worksheet that is designated for new alerts 
For i = LBound(newRow) To UBound(newRow) 
    newRow(i) = coll(i + 1) 'Collections are 1-based 
    'Debug.Print newRow(i) 
    ActiveWorkbook.Sheets("Sheet" & index + 4).Select 
    ActiveWorkbook.Sheets("Sheet" & index + 4).Cells(1, i + 1).Value = newRow(i) 

Next i 


'if NEW alerts have been found, call SaveFile 
If IsEmpty(ActiveWorkbook.Sheets("Sheet" & index + 4).Cells(1, 1)) = False  Then 
     Call SaveFile 
End If 

End Sub 
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~