根据条件对列值求和

Question

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

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

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

自从这个星期一以来我一直在努力做的事情：仅当 COL A、col B、col C、col、col E、col F 的行具有等效的单元格值时，对 Q 列中的金额值求和（“AMOUNT”）。

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

我的数据库；

A 列	B 列	COL C	COL E	COL F	COL Q
代码	雕像	属性	国家	首都	金额
A1	好的	Z1	英国	伦敦	400
C1	挪威克朗	R2	西班牙	马德里	50
A1	好的	Z1	英国	伦敦	300
D1	待定	X	加拿大	渥太华	10

预期的输出；

A 列	B 列	COL C	COL E	COL F	COL Q
代码	雕像	属性	国家	首都	金额
A1	好的	Z1	英国	伦敦	700
C1	挪威克朗	R2	西班牙	马德里	50
D1	待定	X	加拿大	渥太华	10

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

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

工作表中的数据库（“金额”）可能会有所不同，并且可能会获得更多或更少的行，因此我需要将此过程自动化。

这是我最后保存的代码：

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 中会很简单：

按这些列分组
按 Amount

Sum

Power Query 在 Windows Excel 2010+ 和 Office 365

中可用

使用 Power Query

Select 数据中的某个单元格 Table
Data => Get&Transform => from Table/Range
当 PQ 编辑器打开时：Home => Advanced Editor
记下第 2 行中的 Table 名称
粘贴下面的 M 代码代替您看到的内容
将第 2 行中的 Table 名称更改回最初生成的名称。
阅读评论并探索 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 的 sheet 中。结果将写入名称为 Result 的 sheet。两个 sheet 都应该存在于工作簿中运行代码之前。

数据透视表无需任何编码，也无需 VBA 或 M 即可提供您想要的内容

根据条件对列值求和

Sum column values based on condition

excel

foreach

vba

if-statement

date-range