使用sum if对列进行分组并对其值求和

Question

目标是创建一个接受以下输入数据的宏：

并返回以下结果：

该宏应使用“ ID”列将行分组并汇总“值”列，同时保留“名”，“姓”和“日期”列。如果可以简化结果，则结果可以放在新的工作表上。

Answer 1

解决您问题的一种方法是在excel中使用SUMIFS函数。

Excel中的SUMIF函数将采用以下值：

SUMIFS(sum_range, criteria_range1, criteria1)

在您的情况下，我们想

Sum_range：值

criteria_range1：名字

criteria1：条件范围内的每个名称，因此我们需要找到唯一的名称，然后遍历该唯一列表。

由于将所有内容归为一个标准，所以我认为SUMIF足以解决此问题。

我相信这已经足够了，但是如果您愿意，可以编写一些代码行来实现。.

结果：

VBA代码：

Option Explicit
Sub Sumifs()

Dim ws As Worksheet
Dim ws2 As Worksheet
Dim Arg1 As Range 'the range to sum : values
Dim Arg2 As Range 'criteria for range: First Name
Dim Arg3 As Variant 'the criteria (range), each name
Dim ColData As Long
Dim ColOutput As Long
Dim unique()
Dim ct As Long
Dim lrow As Long
Dim x As Long
Dim lrow2 As Long
Dim cell_value As Variant

'################### Set Variables ###################
Set ws = ActiveWorkbook.Worksheets("Sheet1") 'Data
Set ws2 = ActiveWorkbook.Worksheets("Sheet1") 'Output

Set Arg1 = ws.Range("E2:E12") 'Sum_range
Set Arg2 = ws.Range("B2:B12") 'Criteria_range1
Set Arg3 = ws2.Range("A2:A12") 'Criteria1

ColData = 1 'Start Column of Data
ColOutput = 10 'Start Column of Output
'#####################################################

ws2.Range(ws2.Cells(1, ColOutput), ws2.Cells(1, ColOutput + 4)).Value = ws.Range(ws.Cells(1, ColData), ws.Cells(1, ColData + 4)).Value 'Copy Headers

'################### Find unique Values in Data ###################
ReDim unique(ws.Cells(ws.Rows.Count, ColData + 1).End(xlUp).Row)
lrow = ws2.Cells(Rows.Count, ColOutput + 4).End(xlUp).Row + 1 'Find first row to fill with unique values

For x = 2 To ws.Cells(ws.Rows.Count, ColData + 1).End(xlUp).Row 'Column to check for unique values
    If CountIfArray(ws.Cells(x, ColData + 1), unique()) = 0 Then 'Build array to store unique values.
        unique(ct) = ws.Cells(x, ColData + 1).Text 'Populate the array
            ws2.Cells(lrow, ColOutput).Value = ws.Cells(x, ColData).Value 'copy unique value to output, ID
            ws2.Cells(lrow, ColOutput + 1).Value = ws.Cells(x, ColData + 1).Value 'copy unique value to output, First Name
            ws2.Cells(lrow, ColOutput + 2).Value = ws.Cells(x, ColData + 2).Value 'copy unique value to output, Last Name
            ws2.Cells(lrow, ColOutput + 3).Value = ws.Cells(x, ColData + 3).Value 'copy unique value to output, Date


            '######### Add more columns to copy, don't forget to increase your "ColOutput = 10" so the output start more to the right, 3 examples below
            ws2.Cells(lrow, ColOutput + 4).Value = ws.Cells(x, ColData + 4).Value 'copy unique value to output, New value
            ws2.Cells(lrow, ColOutput + 5).Value = ws.Cells(x, ColData + 5).Value 'copy unique value to output, New value 2
            ws2.Cells(lrow, ColOutput + 6).Value = ws.Cells(x, ColData + 6).Value 'copy unique value to output, New value 3

            lrow = lrow + 1 'Add one to last row
        ct = ct + 1 'Add counter
    End If
Next x
ReDim Preserve unique(ct - 1) 'Rezise Array
'##################################################################

'################### Sumif and output ###################
lrow2 = ws2.Cells(Rows.Count, ColOutput + 4).End(xlUp).Row + 1 'Find first row to fill with unique values
    For Each cell_value In unique 'Loop through all unique values in range set in Arg3
                ws2.Cells(lrow2, ColOutput + 4) = Application.WorksheetFunction.Sumifs(Arg1, Arg2, cell_value) 'Perform SUMIFS()
                lrow2 = lrow2 + 1 'Add one row
    Next cell_value 'to to next unique value
'#########################################################

End Sub
Public Function CountIfArray(lookup_val As String, lookup_arr As Variant)
CountIfArray = Application.Count(Application.Match(lookup_val, lookup_arr, 0))
End Function