Excel VBA：合并行和求和值

Question

我已经阅读了关于合并行和合并数据的所有其他问题。我确实遇到了一个我认为对我有用的解决方案，但是当我运行宏时，它实际上并没有对正确的列求和。作为 VBA 的新手，我无法弄清楚宏中需要更改哪些内容才能在我的工作表中工作。

背景： 我想使用宏，因为我每天都会收到一份报告，我必须对其进行操作，以便它可以处理到我们的系统中。我创建了一个 VBA 宏来为我进行操作，但我意识到该报告现在有具有不同值的重复行。下面是最后一组数字需要相加的示例。 （我的实际报告中的 J 栏）

即

第 1 行：C3=1234，名称，C5=ABC，C5Name，C4=DEF，C4Name，21361

第 2 行：C3=1234，名称，C5=ABC，C5Name，C4=DEF，C4Name，132165

这是我找到的解决方案，但我需要知道要更改哪些内容以与我实际需要总结的列相对应。

Sub Merge()

Dim ColumnsCount As Integer
Dim i As Integer

Range("A1").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
    OrderCustom:=1, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

Do While ActiveCell.Row <= ActiveSheet.UsedRange.Rows.Count
    If ActiveCell.Value = ActiveCell.Offset(1, 0).Value Then
        For i = 1 To ColumnsCount - 1
            ActiveCell.Offset(0, i).Value = ActiveCell.Offset(0, i).Value +     ActiveCell.Offset(1, i).Value
        Next
        ActiveCell.Offset(1, 0).EntireRow.Delete shift:=xlShiftUp
    Else
        ActiveCell.Offset(1, 0).Select
    End If
Loop

End Sub

非常感谢任何和所有帮助。如果我需要提供更多信息，请告诉我。

~安德烈亚

Answer 1

看看你的桌子会更好。你还没有解释清楚。这个答案与user1016274 的答案没有太大区别。上面的代码首先按B、D 和H 列排序，然后通过比较相同的列，在将它们的J 列值相加时检查并删除重复项。

Sub Merge()

    Range("A1").Sort Key1:=Range("B1"), Order1:=xlAscending, Key2:=Range("D1"), Order2:=xlAscending, _
    Key3:=Range("H1"), Order3:=xlAscending, Header:=xlYes
    'I assume there are column headers. If not, use "Header:=xlNo" instead of "Header:=xlYes"

    Range("A2").Select 'I assume there are column headers. If not, use "Range("A1").Select" instead of "Range("A2").Select"

    Do While ActiveCell.Row <= ActiveSheet.UsedRange.Rows.Count
        If ActiveCell.Offset(0, 1).Value = ActiveCell.Offset(1, 1).Value And ActiveCell.Offset(0, 3).Value = ActiveCell.Offset(1, 3).Value And ActiveCell.Offset(0, 7).Value = ActiveCell.Offset(1, 7).Value Then
            ActiveCell.Offset(0, 9).Value = ActiveCell.Offset(0, 9).Value + ActiveCell.Offset(1, 9).Value
            ActiveCell.Offset(1, 0).EntireRow.Delete shift:=xlShiftUp
        Else
            ActiveCell.Offset(1, 0).Select
        End If
    Loop

End Sub

Answer 2

您不必为了添加列 J 的值而遍历所有列：

    If ActiveCell.Value = ActiveCell.Offset(1, 0).Value Then
        ActiveCell.Offset(0, 10).Value = ActiveCell.Offset(0, 10).Value +     ActiveCell.Offset(1, 10).Value
        ActiveCell.Offset(1, 0).EntireRow.Delete shift:=xlShiftUp
    Else
        ActiveCell.Offset(1, 0).Select
    End If

顺便说一句，您确定要仅在该行不重复的情况下才增加活动单元格的行吗？可能是因为 DeleteRow 操作而起作用，但我只是想问一下。
编辑：已删除孤立的 Next 声明，抱歉。