在工作表中组合行和总和值

Posted 2023-03-31

【中文标题】在工作表中组合行和总和值

【英文标题】：Combine Rows & Sum Values in a Worksheet

【发布时间】：2015-06-05 17:35:40

【问题描述】：

我有一个 Excel 表，其中包含以下数据（管道“|”用于分隔列）。

A|B|C|X|50|60
D|E|F|X|40|30
A|B|C|X|10|20
A|B|C|Y|20|20
A|B|C|X|20|70
D|E|F|X|10|50
A|B|C|Y|10|10

我想要得到的结果是：

A|B|C|X|80|150
A|B|C|Y|30|30
D|E|F|X|50|80

值 A、B、C 和 D、E、F 就像唯一标识符。实际上只能考虑A或D。值 X 和 Y 就像“类型”，整数是要求和的值。这个样本被简化了，有数千个唯一标识符，十几个类型和几十个值要求和。行未排序，类型可以位于较高或较低的行中。我试图避免使用数据透视表。

Dim LastRow As Integer
Dim LastCol As Integer
Dim i As Integer

LastCol = Sheets(1).Cells(1, Columns.Count).End(xlToLeft).Column
LastRow = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row

For i = 1 To LastRow
????
Next i

上面的代码到达了循环遍历行的位置，但我不清楚在那之后要做什么。

【问题讨论】：

因此，如果我理解您的问题，对于列 A、B、C、D 中的每个唯一值组合，您想分别对列 E 和 F 求和吗？如果是这样，您打算将结果放在哪里？您需要使用一个数组来存储组合（cols A&B&C&D）并存储两个总和。当您从一行到另一行时，您查看数组以查看该组合是否已经存在。如果是这样，请将新的 E、F 值添加到数组中已有的内容中。如果该组合不存在，则使用此新组合在数组末尾添加一个新条目，并存储 E、F 值。

结果将在第一个唯一标识符行中。具有唯一标识符的第一行保留下来，并从其他行（已删除）中添加其总和。

大声笑，这不是家庭作业。这些记录是来自 PRM-9000 的辐射测量值：D

【参考方案1】：

按您认为重要的所有字母列对它们进行排序。

在右侧未使用的列中，在第二行使用如下公式，

=IF($A2&$B2&$C2&$D2=$A3&$B3&$C3&$D3, "", SUMIFS(E:E,$A:$A, $A2,$B:$B, $B2 ,$C:$C, $C2,$D:$D, $D2))

将该公式复制到右侧一列，然后将两列向下填充到您的数据为止

过滤两列，删除空白。

        

可选择将数据复制到新的报告工作表并删除 E 和 F 列。

附录：

使用某种形式的数组和一些简单的数学运算可以实现更自动化的方法。我选择了一个字典对象，以便利用它的索引 Key 来识别前四个字母标识符中的模式。

要使用脚本字典，您需要进入 VBE 的工具 ► 参考并添加 Microsoft 脚本运行时。没有它，下面的代码将无法编译。

以下内容已针对键和整数的动态列进行了调整。

Sub rad_collection()
    Dim rw As Long, nc As Long, sTMP As String, v As Long, vTMP As Variant
    Dim i As Long, iNumKeys As Long, iNumInts As Long
    Dim dRADs As New Scripting.Dictionary

    dRADs.CompareMode = vbTextCompare
    iNumKeys = 5    'possibly calculated by num text (see below)
    iNumInts = 2    'possibly calculated by num ints (see below)

    With ThisWorkbook.Sheets("Sheet4").Cells(1, 1).CurrentRegion
        'iNumKeys = Application.CountA(.Rows(2)) - Application.Count(.Rows(2))  'alternate count of txts
        'iNumInts = Application.Count(.Rows(2))    'alternate count of ints
        For rw = 2 To .Cells(Rows.Count, 1).End(xlUp).row
                vTMP = .Cells(rw, 1).Resize(1, iNumKeys).Value2
                sTMP = Join(Application.Index(vTMP, 1, 0), Chr(183))
                If Not dRADs.Exists(sTMP) Then
                    dRADs.Add Key:=sTMP, Item:=Join(Application.Index(.Cells(rw, iNumKeys + 1).Resize(1, iNumInts).Value2, 1, 0), Chr(183))
                Else
                    vTMP = Split(dRADs.Item(sTMP), Chr(183))
                    For v = LBound(vTMP) To UBound(vTMP)
                        vTMP(v) = vTMP(v) + .Cells(rw, iNumKeys + 1 + v).Value2
                    Next v
                    dRADs.Item(sTMP) = Join(vTMP, Chr(183))
                End If

        Next rw

        rw = 1
        nc = iNumKeys + iNumInts + 1
        .Cells(rw, nc + 1).CurrentRegion.ClearContents  'clear previous
        .Cells(rw, nc + 1).Resize(1, nc - 1) = .Cells(rw, 1).Resize(1, nc - 1).Value2
        For Each vTMP In dRADs.Keys
            'Debug.Print vTMP & "|" & dRADs.Item(vTMP)
            rw = rw + 1
            .Cells(rw, nc + 1).Resize(1, iNumKeys) = Split(vTMP, Chr(183))
            .Cells(rw, nc + iNumKeys + 1).Resize(1, iNumInts) = Split(dRADs.Item(vTMP), Chr(183))
            .Cells(rw, nc + iNumKeys + 1).Resize(1, iNumInts) = _
              .Cells(rw, nc + iNumKeys + 1).Resize(1, iNumInts).Value2
        Next vTMP
    End With

    dRADs.RemoveAll: Set dRADs = Nothing

End Sub

只需针对您作为示例提供的数字运行宏即可。我在第一行假设了某种形式的列标题标签。字典对象被填充，组合标识符中的重复项将其数字相加。剩下的就是将它们拆分回来并将它们返回到未使用区域的工作表中。

    

Microsoft 脚本运行时的位置 - 在 Visual Basic 编辑器（又名 VBE）中，选择工具 ► 参考（Alt+T,R）然后向下滚动超过一半即可找到它。

        

【讨论】：

感谢 Jeeped：它有效！但是除了公式没有其他方法吗？我正在为此寻找仅 VBA 的解决方案。

谢谢吉普！看起来很神奇！但我收到“编译错误，未定义用户定义类型”。关于 Dim dRADs As New Scripting.Dictionary :( 知道导致错误的原因吗？

不用担心。对不起，我不知道更好。我使用 Excel 2010（在 Windows 7 上），但找不到 Windows 脚本运行时。看来我必须下载它。您使用的是哪个版本的 Excel？你也必须下载它吗？

在没有 Windows 脚本运行时的情况下有什么办法吗？我曾尝试下载/安装 WSR，但它给了我错误 :( 似乎脚本字典的替代品将是一个数组（我正在尝试就该主题进行自我教育）。

谢谢吉普德。不敢相信我错过了。一切都像一个魅力。积极学习你写的东西，熟悉数组，但不是那种复杂的。