Как удалить дубликаты объединения

Question

У меня проблема

Мне нужно удалить дубликаты из столбца 3, но только если столбец 1 совпадает, а дубликаты значений суммы дублируются.

Спасибо за ответы

Answer 1

Попробуйте:

Option Explicit

Sub test()

    Dim LastrowA As Long, LastrowF, i As Long, y As Long, j As Long
    Dim Ad_Desc As String
    Dim Total As Double
    Dim arr As Variant
    Dim Exist As Boolean

    With ThisWorkbook.Worksheets("Sheet1")

        LastrowA = .Cells(.Rows.Count, "A").End(xlUp).Row

        For i = 2 To LastrowA
            Ad_Desc = .Range("A" & i).Value & "_" & .Range("C" & i).Value
            Total = .Range("B" & i).Value

            If i = 2 Then
                For y = i + 1 To LastrowA
                    If .Range("A" & y).Value & "_" & .Range("C" & y).Value = Ad_Desc Then
                        Total = Total + .Range("B" & y).Value
                    End If
                Next y

                    LastrowF = .Cells(.Rows.Count, "F").End(xlUp).Row
                    .Range("F" & LastrowF + 1).Value = .Range("A" & i).Value
                    .Range("G" & LastrowF + 1).Value = Total
                    .Range("H" & LastrowF + 1).Value = .Range("C" & i).Value


                    arr = Array(Ad_Desc)

            Else
                Exist = False
                For j = LBound(arr) To UBound(arr)
                    If arr(j) = Ad_Desc Then
                        Exist = True
                        Exit For
                    Else
                        Exist = False
                    End If
                Next j

                If Exist = False Then

                    For y = i + 1 To LastrowA
                        If .Range("A" & y).Value & "_" & .Range("C" & y).Value = Ad_Desc Then
                            Total = Total + .Range("B" & y).Value
                        End If
                    Next y

                    LastrowF = .Cells(.Rows.Count, "F").End(xlUp).Row
                    .Range("F" & LastrowF + 1).Value = .Range("A" & i).Value
                    .Range("G" & LastrowF + 1).Value = Total
                    .Range("H" & LastrowF + 1).Value = .Range("C" & i).Value

                    ReDim Preserve arr(0 To UBound(arr) + 1)
                        arr(UBound(arr)) = Ad_Desc

                End If

            End If

        Next i

    End With

End Sub

Результат:

Answer 2

Я ввел данные вашего образца в диапазоне A20: C29.Затем я создал вспомогательный столбец с формулой ниже.

=SUMIFS($B$20:$B$29,$A$20:$A$29,$A20,$C$20:$C$29,$C20)

Скопируйте вспомогательный столбец в буфер обмена и PasteSpecial> Values ​​(чтобы заменить формулы значениями результата).

Затем вырезать / вставить вспомогательный столбец в столбец B и Удалить дубликаты на основе столбцов A и C.