组合行工作表中的总和值 [英] Combine Rows & Sum Values in a Worksheet

问题描述

  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 
 
对于i = 1 To LastRow 
 ???? 
 Next i 
  
上面的代码到了循环遍历行，但我是不清楚该点后面的内容。
解决方案
 
 
 
在您认为重要的所有字母列中排序。 
 
 
 
在未使用的列中，使用第二行中的以下公式，
 
 
 
 = IF $，$，$，$，$，$，$，$ ，$ C：$ C，$ C2，$ D：$ D，$ D2））
 
 
 
 
将该公式复制一列，然后将这两列填充为只要您的数据
 
 
 
 
过滤两列，删除空白。
 
 
 
  
 
 
 
 
可选复制数据到新的报告工作表，并删除列E& F。
 
 
 
 附录： 
 
 
通过某种形式的阵列和一些简单的数学运算，可以实现更自动化的方法。我选择了一个字典对象，以便利用其索引的键来识别前四个字母标识符中的模式。
 
 
 
要使用一个脚本字典，您需要进入VBE的工具►参考和添加Microsoft Scripting Runtime。以下代码将无法编译。
 
 
 
以下内容已针对键和整数的动态列进行了调整。
  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'可能由num文本计算（见下文）
 iNumInts = 2'可能由num ints计算（见下文）
 
使用ThisWorkbook.Sheets（Sheet4）。单元格（1，1）.CurrentRegion 
'iNumKeys = Application.CountA .Rows（2）） -  Application.Count（.Rows（2））'txts的交替计数
'iNumInts = Application.Count（.Rows（2））'ints的交替计数
对于rw = 2到.Cells（Rows.Count，1）.End（xlUp）.row 
 vTMP = .Cells（rw，1）.Resize（1，iNumKeys）.Value2 
 sTMP = Join（Application.Index（vTMP，1，0），Chr（183））
如果不是dRADs.Exists（sTMP）然后
 dRADs.Add Key：= sTMP，Item：= Join .Index（.Cells（rw，iNumKeys + 1）.Resize（1，iNumInts）.Value2,1,0），Chr（183））
 Else 
 vTMP = Split（dRADs.Item（sTMP ），Chr（183））
对于v = LBound（vTMP）到UBound（vTMP）
 vTMP（v）= vTMP（v）+ .Cells（rw，iNumKeys + 1 + v）.Value2 
下一个v 
 dRADs.Item（sTMP）=加入（vTMP，Chr（183））
如果
 
下一个rw 
 
 rw = 1 
 nc = iNumKeys + iNumInts + 1 
 .Cells（rw，nc + 1）.CurrentRegion.ClearContents'清除以前的
 .Cells（rw，nc + 1）.Resize 1，nc  -  1）= .Cells（rw，1）.Resize（1，nc  -  1）.Value2 
对于每个vTMP在dRADs.Keys 
'Debug.Print vTMP& | &安培; dRADs.Item（vTMP）
 rw = rw + 1 
 .Cells（rw，nc + 1）.Resize（1，iNumKeys）= Split（vTMP，Chr（183））
。单元格（rw，nc + iNumKeys + 1）.Resize（1，iNumInts）= Split（dRADs.Item（vTMP），Chr（183））
 .Cells（rw，nc + iNumKeys + 1） 1，iNumInts）= _ 
 .Cells（rw，nc + iNumKeys + 1）.Resize（1，iNumInts）.Value2 
下一个vTMP 
结束
 
 dRADs.RemoveAll：设置dRADs = Nothing 
 
 End Sub 
  
只需运行宏与您提供的数字作为样本。我在第一行中采用了某种形式的列标题标签。字典对象被填充，并且组合的标识符中的重复数字的数字相加。剩下的就是将它们分开并将它们返回到一个未使用区域的工作表。
 
 
 
  
 
 
 
 Microsoft脚本运行时的位置 - 在Visual Basic编辑器（又名VBE）中，选择工具►参考（  Alt  +  T ， R ），向下滚动一点以上，找到它。
 
 
 
  
 
I have an excel sheet with the below (pipe "|" to delimit columns) data.
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
The result I am trying to get is:
A|B|C|X|80|150
A|B|C|Y|30|30
D|E|F|X|50|80
Values A, B, C and D, E, F are like unique identifiers. Actually only A or D can be considered. Values X and Y are like "types", and the integers are the values to sum. This sample was simplified, there are thousands of unique identifiers, dozen of types and dozens of values to sum. The rows are not sorted, the types can be located in higher or lower rows. I am trying to avoid the use of a pivot table.
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
The code above gets to the point of looping through the rows but I am unclear on what to after that point.
解决方案

Sort them on all alphabetic columns you deem important.
In an unused column to the right use a formula like the following in the second row,

=IF($A2&$B2&$C2&$D2=$A3&$B3&$C3&$D3, "", SUMIFS(E:E,$A:$A, $A2,$B:$B, $B2,$C:$C, $C2,$D:$D, $D2))
Copy that formula right one column then fill both columns down as far as your data goes
Filter on the two columns, removing blanks.

        
Optionally copy the data to a new report worksheet and remove columns E & F.
Addendum:

A more automated approach could be achieved with some form of array and some simple mathematical operations. I've chosen a dictionary object in order to take use of its indexed Key to recognize patterns in the first four alphabetic identifiers.

To use a scripting dictionary, you need to go into the VBE's Tools ► References and add Microsoft Scripting Runtime. The following code will not compile without it.

The following has been adjusted for dynamic columns of keys and integers.
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
Just run the macro against the numbers you have provided as samples. I've assumed some form of column header labels in the first row. The dictionary object is populated and duplicates in the combined identifiers have their numbers summed. All that is left is to split them back up and return them to the worksheet in an unused area.

    

Location of Microsoft Scripting Runtime - In the Visual Basic Editor (aka VBE) choose Tools ► References (Alt+T,R) and scroll down a little more than halfway to find it.

        

                        
这篇关于组合行工作表中的总和值的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！