如何按类别对行值求和

时间:2018-09-12 09:13:47

标签: excel vba excel-vba

例如,我在Excel中有下表(实际上有100多个行):

Alfa     10
Beta     5
Alfa     10
Beta     5
Gama     15

我想使用VBA宏按名称(类别)求SUM值,因此我可以将其显示在工作表中,如下所示:

AlfaTotal     20
BetaTotal     10
GamaTotal     15

我尝试使用For Each函数,但是无法获取这些值。任何帮助将不胜感激。

2 个答案:

答案 0 :(得分:1)

使用字典是一种常见的方法。如果仅存在一项,则以下内容将处理范围内的空白。它不需要进行.Exists测试,因为只需通过直接访问即可将其添加到任何现有值中。此外,一次性写入键数组和项。

Option Explicit
Public Sub GetTotals()
    Dim dict As Object, arr(), i As Long, lastRow As Long
    Set dict = CreateObject("Scripting.Dictionary")
    With ThisWorkbook.Worksheets("Sheet1")       '<==source data
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        Select Case lastRow
        Case 1
            ReDim arr(1, 1): arr(1, 1) = .Range("A1:B1").Value
        Case Else
            arr = .Range("A1:B" & lastRow).Value
        End Select
    End With

    For i = LBound(arr, 1) To UBound(arr, 1)
        If Not IsEmpty(arr(i, 1)) Then
            dict(arr(i, 1)) = dict(arr(i, 1)) + arr(i, 2)
        End If
    Next
    With ThisWorkbook.Worksheets("Sheet2")
        .Range("A1").Resize(dict.Count, 1) = Application.WorksheetFunction.Transpose(dict.keys)
        .Range("B1").Resize(dict.Count, 1) = Application.WorksheetFunction.Transpose(dict.Items)
    End With
End Sub

结果:

data

答案 1 :(得分:1)

如果在尝试对类别进行汇总之前不知道要拥有多少个类别,则可以使用以下解决方法:

Option Explicit

Sub test()
    Dim d As Object
    Set d = CreateObject("Scripting.Dictionary")

    Dim s As String, key_value As String
    Dim v As Variant
    Dim num As Long

    Dim r As Range, c As Range
    Set r = Sheet1.Range(Sheet1.Range("A2"), Sheet1.Range("A" & Sheet1.Rows.Count).End(xlUp))

    For Each c In r
        key_value = CStr(c)
        num = CLng(c.Offset(0, 1))

        If d.Exists(key_value) Then
            d(key_value) = d(key_value) + num
        Else
            d.Add Key:=key_value, Item:=num
        End If
    Next c

    For Each v In d
        s = s & CStr(v) & vbTab & CStr(d(v)) & vbLf
    Next v

    MsgBox prompt:=s, Title:="Summation", Buttons:=vbInformation
End Sub

如果您事先知道要使用哪些类别,则仅根据这些类别创建一些sumif公式可能会更简单。