根据条件对列值求和

Question

我是一名实习生，自周一以来我一直在努力寻找解决方案…… 我是 VBA 新手，我不清楚如何根据某些条件对列中的单元格求和。我尝试了多个代码，但一旦我的代码不起作用，我就删除了它们。

所以我想做的是以下内容；

我有一个名为 worksheets("Amounts") 的工作表，其中有一个数据库。

自周一以来我一直在努力做的事情： 将 Q 列中的金额值相加（“AMOUNT”）仅当 COL A、col B、col C、col、col E、col F 的行具有相等的单元格值时。

然后，我想在 col Q 中根据前一个条件对金额求和，并将总计放在一行中，以代替包含共同值的行。 在我想删除彼此匹配的每一行以显示具有共同值的合计金额之后。像下面的例子；

我的数据库；

COL A	COL B	COL C	COL E	COL F	COL Q
CODE	STATUE	ATTRIBUTE	Country	Capital	AMOUNT
A1	OK	Z1	ENGLAND	LONDON	400
C1	NOK	R2	SPAIN	MADRID	50
A1	OK	Z1	ENGLAND	LONDON	300
D1	PENDING	X	CANADA	OTTAWA	10

预期的输出；

COL A	COL B	COL C	COL E	COL F	COL Q
CODE	STATUE	ATTRIBUTE	Country	Capital	AMOUNT
A1	OK	Z1	ENGLAND	LONDON	700
C1	NOK	R2	SPAIN	MADRID	50
D1	PENDING	X	CANADA	OTTAWA	10

==> 所以这里我们只有 2 行在 col A、B、C、E 和 F 上具有共同值。我想将这两行的数量相加并删除这两行以形成一个使用这些常见的值，例如上面的示例。

显然对于与其他行不匹配的其他行，我想让它们保持原样。

worksheets("Amount") 中的数据库可能会有所不同，并且可以获取更多或更少的行，因此我需要将这个过程自动化。

这是我最后保存的代码：

Option Explicit

Sub agreg()
Dim i As Long
Dim ran1 As Range

ran1 = ThisWorkbook.Worksheets("Values").Range("A" & Worksheets("Values").Rows.Count).End(xlUp).row + 1
For Each i In ran1
   If Cells(i, 1) = Range("A1", Range("A1").End(xlDown)).Value Then
       cells(i,4) + range("D1",range("D1").End(xlDown)).Value
       
    End If
Next i

   
End Sub  ```

Answer 1

请测试下一个代码：

Sub SumUnique5Cols()
   Dim sh As Worksheet, lastRow As Long, arr, arrQ, rngDel As Range, i As Long, dict As Object
   
   Set sh = Worksheets("Amounts")
   lastRow = sh.Range("A" & sh.rows.count).End(xlUp).row 'last row based on A:A column
   arr = sh.Range("A2:Q" & lastRow).Value2               'place the range in an array to make the code faster
   Set dict = CreateObject("Scripting.Dictionary")       'set a dictionary to keep the unique keys combination value
   
   For i = 1 To UBound(arr)            'iterate between the array elements
        If Not dict.Exists(arr(i, 1) & arr(i, 2) & arr(i, 3) & arr(i, 5) & arr(i, 6)) Then 'if the combination key does not exist:
            dict.Add arr(i, 1) & arr(i, 2) & arr(i, 3) & arr(i, 5) & arr(i, 6), arr(i, 17)   'it is created (and take the value of Q:Q cell)
        Else                          'if the key aleready exists, it adds the value in the key item:
            dict(arr(i, 1) & arr(i, 2) & arr(i, 3) & arr(i, 5) & arr(i, 6)) = dict(arr(i, 1) & arr(i, 2) & arr(i, 3) & arr(i, 5) & arr(i, 6)) + arr(i, 17)
            'range of the rows to be deleted is filled in this way:
            If rngDel Is Nothing Then
                Set rngDel = sh.Range("A" & i + 1)                 'if the range does not exist, it is set (i + 1, because of iteration starting from the second row)
            Else
                Set rngDel = Union(rngDel, sh.Range("A" & i + 1)) 'if it exists, a union between the previus range and the new one is created
            End If
        End If
   Next i
   If Not rngDel Is Nothing Then rngDel.EntireRow.Delete     'if there are rows to be deleted, they are deleted
   lastRow = sh.Range("A" & sh.rows.count).End(xlUp).row     'recalculate the last row (after rows deletion)
   arr = sh.Range("A2:Q" & lastRow).Value2                   'place the remained range in an array
   ReDim arrQ(1 To UBound(arr), 1 To 1)                      'ReDim the final array (to keep the summ) according to the remained rows
   For i = 1 To UBound(arr)
        arrQ(i, 1) = dict(arr(i, 1) & arr(i, 2) & arr(i, 3) & arr(i, 5) & arr(i, 6)) 'put in the array the corresponind dictionary key value
   Next i
   sh.Range("Q2").Resize(UBound(arrQ), 1).value = arrQ       'drop the array content at once
End Sub

Answer 2

在 Power Query 中很简单：

• 按这些列分组
• 由Sum 的Amount 聚合

Power Query 在 Windows Excel 2010+ 和 Office 365 中可用

使用 Power Query

• 选择数据表中的某个单元格
• Data => Get&Transform => from Table/Range
• 当 PQ 编辑器打开时：Home => Advanced Editor
• 记下第 2 行中的表 Name
• 粘贴下面的 M 代码代替您看到的内容
• 将第 2 行中的表名称更改回最初生成的名称。
• 阅读 cmets 并探索 Applied Steps 以了解算法

M 码

let

//Change table name in next line to actual table name in the workbook
    Source = Excel.CurrentWorkbook(){[Name="Table10"]}[Content],

//set data types
//note the columns named ColumnN which will be different with your real data
    #"Changed Type" = Table.TransformColumnTypes(Source,{
        {"CODE", type text}, 
        {"STATUE", type text}, 
        {"ATTRIBUTE", type text}, 
        {"Column1", type any}, 
        {"Country", type text}, 
        {"Capital", type text}, 
        {"Column2", type any}, {"Column3", type any}, {"Column4", type any}, {"Column5", type any}, {"Column6", type any}, {"Column7", type any}, {"Column8", type any}, {"Column9", type any}, {"Column10", type any}, {"Column11", type any}, 
        {"Amount", Int64.Type}}),

//group by columns 1,2,3,5,6
//return Sum of the Amount Column
    #"Grouped Rows" = Table.Group(#"Changed Type", {"CODE", "STATUE", "ATTRIBUTE", "Country", "Capital"}, 
        {{"Amount", each List.Sum([Amount]), type nullable number}})
        
in
    #"Grouped Rows"

数据

结果

Answer 3

如果你想用 VBA 来做，我会使用 ADODB 对行进行分组

Public Sub SumGroup()

    Dim connection As Object
    Set connection = CreateObject("ADODB.Connection")
    connection.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
        "Data Source=" & ThisWorkbook.FullName & ";" & _
        "Extended Properties=""Excel 8.0;HDR=Yes;"";"

    Dim recordset As Object
        
    Dim sSQL As String
    sSQL = "SELECT Code, Statue, Attribute, Country, Capital,  Sum(Amount) as SumAmount FROM [Database$] GROUP BY Code, Statue, Attribute, Country, Capital"
    
    Set recordset = connection.Execute(sSQL)
    Worksheets("Result").Range("A1").CopyFromRecordset recordset
    
    recordset.Close
    connection.Close


End Sub

数据应位于名称为Database 的工作表中。结果将写入名为Result 的工作表中。在运行代码之前，这两个工作表都应该存在于工作簿中。

数据透视表可以为您提供所需的内容，无需任何编码，也无需使用 VBA 或 M