如何删除合并重复项

时间:2019-02-13 09:38:48

标签: excel vba duplicates

我有问题

enter image description here

我必须从第3列中删除重复项,但只有在第1列相同的情况下才删除,并且求和值重复项。

感谢答案

2 个答案:

答案 0 :(得分:0)

我在A20:C29范围内输入了您的样本数据。然后,我用下面的公式创建了一个帮助器列。

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

将帮助程序列复制到“剪贴板”和“ PasteSpecial”>“值”(以结果值替换公式)。

然后将帮助程序列剪切/粘贴到B列,并基于A列和C列删除重复项

答案 1 :(得分:0)

尝试:

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

结果:

enter image description here