使用VBA在一張Excel工作表中比較4列

Question

我需要你的幫助，我在excel表中有4列，我需要比較它們2比2我會向你解釋：

在A列中，我有用戶（user1，user2，user3 ...）在B列中，我具有功能（fonc1，fonc2，fonc3 .....）

在C列中，我有用戶（user1，user2，user3 ...）在D列中，我具有功能（fonc1，fonc2，fonc3 .....）

C和D列是C和D列中A和B列的新版本，用戶可以更改順序或更改功能。

當我執行代碼時，我將結果放在其他新列中：F列，其中有users列，G處，我放置Del​​eted_functionalities列H位置，我將New_functionalities放置

第一個問題是代碼不會讓用戶只獲得新的和刪除的功能。 第二個問題是，當列A超過列C用戶庫存時，代碼不起作用。 您能幫我找到解決方案嗎？ 先感謝您 。 這是我的代碼和我正在處理的文件：

Private Sub CommandButton2_Click()
  Dim rngCell As Range
    For Each rngCell In Range("B2:B2000")
        If WorksheetFunction.CountIf(Range("D2:D2000"), rngCell) = 0 Then
            Range("G" & Rows.Count).End(xlUp).Offset(1) = rngCell
        End If
    Next
    For Each rngCell In Range("D2:D2000")
        If WorksheetFunction.CountIf(Range("B2:B2000"), rngCell) = 0 Then
            Range("H" & Rows.Count).End(xlUp).Offset(1) = rngCell
        End If
    Next
End Sub

這是excel文件http://www.cjoint.com/c/FCxnwjp22rv

Answer 1

我希望我得到你想要達到的目標。 以下內容可以解決您的問題嗎？

 Private Sub CommandButton2_Click()
  Dim rngCell As Range
    For Each rngCell In Range("A2:A20000")
        If WorksheetFunction.CountIf(Range("C2:C20000"), rngCell) > 0 Then
            Range("F" & Rows.Count).End(xlUp).Offset(1) = rngCell
            Range("F" & Rows.Count).End(xlUp).Offset(0, 1) = rngCell.Offset(0, 1).Value
            Range("F" & Rows.Count).End(xlUp).Offset(0, 2) = Application.WorksheetFunction.VLookup(rngCell.Value, Range("C2:D20000"), 2, 0)
        ElseIf (rngCell <> "") Then

            Range("F" & Rows.Count).End(xlUp).Offset(1) = rngCell
            Range("F" & Rows.Count).End(xlUp).Offset(0, 1) = rngCell.Offset(0, 1).Value

        End If
    Next

    For Each rngCell In Range("C2:C20000")
        If (WorksheetFunction.CountIf(Range("A2:A20000"), rngCell) = 0 And rngCell <> "") Then
              Range("F" & Rows.Count).End(xlUp).Offset(1) = rngCell
              Range("F" & Rows.Count).End(xlUp).Offset(0, 2) = rngCell.Offset(0, 1).Value
        End If
    Next


End Sub

僅當用戶同時出現在A列和C列中時，該用戶才被包括在F列中。如果要包括A列或C列中的每個用戶，則必須更改代碼。

Answer 2

嘗試這個

Private Sub CommandButton2_Click()
Dim ws As Worksheet
Dim cell As Range, funcCell As Range
Dim oldUserRng As Range, newUserRng As Range, reportRng As Range
Dim iReport As Long
Dim oldFunc As String, newFunc As String

Set ws = ThisWorkbook.Worksheets("users") '<== adapt it to your needs
With ws
    Set oldUserRng = .Columns(1).Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeConstants, xlTextValues)
    Set newUserRng = .Columns(3).Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeConstants, xlTextValues)
    Set reportRng = .Range("F1:I1") '<== added one report column to account for unchanged functions
End With

reportRng.Value = Array("user", "deleted", "new", "same")
iReport = 1
For Each cell In oldUserRng
    With cell
        oldFunc = .Offset(, 1).Value
        Set funcCell = FindAndOffset(newUserRng, .Value, 1)
        If funcCell Is Nothing Then
            reportRng.Offset(iReport) = Array(.Value, "", "", oldFunc)
        Else
            newFunc = funcCell.Value
            If newFunc = oldFunc Then
                reportRng.Offset(iReport) = Array(.Value, "", "", newFunc)
            Else
                reportRng.Offset(iReport) = Array(.Value, oldFunc, newFunc, "")
            End If
        End If
        iReport = iReport + 1
    End With
Next cell

For Each cell In newUserRng
    With cell
        Set funcCell = FindAndOffset(oldUserRng, .Value, 1)
        If funcCell Is Nothing Then
            reportRng.Offset(iReport) = Array(.Value, "", .Offset(, 1).Value, "")
            iReport = iReport + 1
        End If
    End With
Next cell

End Sub

不太確定它能滿足您的需求。 你最好提供“之前”和“之后”場景的截圖。 順便說一句，可以安全地假設舊用戶列和新用戶列都不能保留重復項（即：A列和/或C列中有兩個或更多“userX”？）

但它確實大大加快了速度，因為它只通過非空單元格進行迭代。