代码中的一些错误，包括在删除第一个重复项之前填充数组，以及将RemoveDuplicates置于With语句之外并包括F列.您的代码可以正常工作，您可以尝试以下操作:

Some mistakes in your code, including populating your array before deleting first duplicates and having your RemoveDuplicates outside your With statement and including column F. To make your code work properly you could try the below:

_之前

Sub Test()

Dim x As Long, arr As Variant, lst As Class1
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")

With Sheet1

    'Step one: Delete duplicates over columns A-E
    x = .Cells(.Rows.Count, 1).End(xlUp).Row
    .Range("A1:F" & x).RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5), Header:=xlYes

    'Step two: Populate your array
    x = .Cells(.Rows.Count, 1).End(xlUp).Row
    arr = .Range("A2:F" & x).Value

    'Step three: Clear range
    .Range("A2:F" & x).ClearContents

    'Step Four: Go through your array and populate a dictionary
    For x = LBound(arr) To UBound(arr)
        Set lst = New Class1
        lst.Col1 = arr(x, 1)
        lst.Col2 = arr(x, 2)
        lst.Col3 = arr(x, 3)
        lst.Col4 = arr(x, 4)
        lst.Col5 = arr(x, 5)
        lst.Col6 = arr(x, 6)
        KeyX = Join(Array(arr(x, 1), arr(x, 2), arr(x, 3)), "|")
        If dict.Exists(KeyX) = False Then
            dict.Add KeyX, lst
        Else
            dict(KeyX).Col4 = dict(KeyX).Col4 + arr(x, 4)
            dict(KeyX).Col5 = dict(KeyX).Col5 + arr(x, 5)
        End If
    Next x

    'Step five: Go through your dictionary and write to sheet
    x = 2
    For Each key In dict.Keys
        .Range(.Cells(x, 1), .Cells(x, 6)).Value = Array(dict(key).Col1, dict(key).Col2, dict(key).Col3, dict(key).Col4, dict(key).Col5, dict(key).Col6)
        x = x + 1
    Next key

End With

End Sub

_之后

让我知道这是怎么回事=)

Let me know how it went =)