excel vba删除重复项并将相应的值相加

时间:2018-03-09 16:24:33

标签: excel-vba vba excel

我找到了这段代码,但我无法让它适用于我的手机范围。我的例子如下。 “更正顺序”在col C中,“Qty”在col D中。我想删除col C中的重复项,将col D中的相应值相加并粘贴到范围F1:G40中。如果我将col C复制并粘贴到Col A,下面的代码可以工作,否则它会删除重复项,但值都是“0”??

A   B   C   D
    Corrected Order (LCP)   Qty
    Orange  12
    Pear    9
    Pear    9
    Pear    6
    Orange  6
    Orange  3
    Orange  1
    Apple   34
    Apple   4
    Apple   4
    Apple   67



Option Explicit

Sub main()

With Worksheets("Fruit Stock") '<== change "Fruit Stock" as per your actual sheet name

    With .Range("C1:D40").Resize(.Cells(.Rows.Count, 3).End(xlUp).Row)
        .Copy
        With .Offset(, .Columns.Count + 1)
            .PasteSpecial xlPasteValues ' copy value and formats
            .Columns(2).Offset(1).Resize(.Rows.Count - 1, 1).FormulaR1C1 = "=SUMIF(C1,RC1,C[-" & .Columns.Count + 1 & "])"
            .Value = .Value
            .RemoveDuplicates 1, xlYes
        End With
    End With

End With
End Sub

1 个答案:

答案 0 :(得分:1)

对&#34; CX,RCX&#34;进行修正。其中X是您的列号(C列X = 3) 还纠正了一些绝对地址,这意味着它只适用于一个案例。 Esp the Resizing到3列没有意义。

Sub main()

With ActiveSheet '<== change "Fruit Stock" as per your actual sheet name

    With Range("C1:D40")
        Set r = .Resize(.Cells(.Rows.Count, .Columns.Count).End(xlUp).Row)

        With r

            .Copy
            With .Offset(, .Columns.Count + 1)
                .PasteSpecial xlPasteValues ' copy value and formats
                .Columns(2).Offset(1).Resize(.Rows.Count - 1, 1).FormulaR1C1 = "=SUMIF(C" & r.Column & ",RC" & r.Column & ",C[-" & .Columns.Count + 1 & "])"
                .Value = .Value
                .RemoveDuplicates 1, xlYes
            End With

        End With

End With
End With
End Sub