用不同的键求和

Question

请参阅附件中的图片以取得更好的主意。

我的工作表中有多行带有组名和很多值。每个组在我的表格中显示多次。现在，我想对每个组的值求和并返回它们。最有效的方法是什么？

现在，我有了将每一行的总值存储到一个数组中并对其进行汇总的代码，如下所示：

Dim arr() as variant
Dim n as integer
Dim sum as variant

For n = firstrow to lastrow   'assume firstrow and lastrow are known numbers

arr = Range(Cells(n, 3),Cells(n,column.count)).Value 
sum = Workbookfunction.sum(arr)

Next n

任何想法都会很有帮助！

Answer 1

使用SUMPRODUCT：

=SUMPRODUCT(($A$7:$A$18=A1)*($B$7:$G$18))

Answer 2

VBA阵列版本

在使用此代码之前，请调整自定义部分中的数据以适合您的需求。
以' str1 = "开头的注释块用于调试。您可以删除它们或取消注释它们以在立即窗口中看到一些“小计”。

Option Explicit

Sub SumGroups()

'-- Customize BEGIN --------------------
  Const cStrG As String = "B2" 'First cell of the group section
  Const cStrD As String = "B15" 'First cell of the data section
'-- Customize END ----------------------

  Dim oRng As Range
  Dim oRngResults As Range

  Dim arrNames As Variant
  Dim arrData As Variant
  Dim arrResults As Variant

  Dim loNames As Long
  Dim loData As Long
  Dim iDataCol As Integer
  Dim dblResults As Double

  'Debug
  Dim lo1 As Long
  Dim i1 As Integer
  Dim str1 As String
  Dim str2 As String
  Dim dTime As Double

'  'Determine the group names range using the first cell of the data section.
'  Set oRng = Range(cStrG).Resize(Range(cStrD).Rows.End(xlUp).Row - 1, 1)

  'Determine the group names range using the last cell of the group section.
  Set oRng = Range(cStrG).Resize(Range(cStrG).Rows.End(xlDown).Row - 1, 1)
  'Determine the range of the results
  Set oRngResults = oRng.Offset(0, 1)
  'Paste the group names range into an array
  arrNames = oRng

'  str1 = "arrNames:"
'  For lo1 = LBound(arrNames) To UBound(arrNames)
'    str1 = str1 & vbCrLf & lo1 & ". " & Chr(9) & arrNames(lo1, 1)
'  Next
'  Debug.Print str1

  'Determine the data range using resize NOT finished.
'  Set oRng = Range(cStrD).Resize(Cells(Cells.Rows.Count, _
      Range(cStrD).Column).End(xlUp).Row - Range(cStrD).Row + 1, 1)

  'Determine the data range not using resize.
  Set oRng = Range(Cells(Range(cStrD).Row, Range(cStrD).Column), _
      Cells(Cells(Cells.Rows.Count, Range(cStrD).Column).End(xlUp).Row, _
      Cells(Range(cStrD).Row, Cells.Columns.Count).End(xlToLeft).Column))
  'Paste the data range into an array
  arrData = oRng

  Set oRng = Nothing 'Release object variable

'  str1 = "arrData:"
'  For lo1 = LBound(arrData) To UBound(arrData)
'    str2 = ""
'    For i1 = LBound(arrData, 2) To UBound(arrData, 2)
'      str2 = str2 & Chr(9) & arrData(lo1, i1)
'    Next
'    str1 = str1 & vbCrLf & lo1 & "." & str2
'  Next
'  Debug.Print str1

  arrResults = oRngResults

  For loNames = LBound(arrNames) To UBound(arrNames)
    dblResults = 0
    For loData = LBound(arrData) To UBound(arrData)
      If arrNames(loNames, 1) = arrData(loData, 1) Then
        For iDataCol = LBound(arrData, 2) + 1 To UBound(arrData, 2)
          dblResults = dblResults + arrData(loData, iDataCol)
        Next
      End If
    Next
    arrResults(loNames, 1) = dblResults
  Next

'  str1 = "arrResults:"
'  For lo1 = LBound(arrResults) To UBound(arrResults)
'    str1 = str1 & vbCrLf & lo1 & ". " & Chr(9) & arrResults(lo1, 1)
'  Next
'  Debug.Print str1

  oRngResults = arrResults

  Set oRngResults = Nothing 'Release object variable

End Sub

在50000行中，它的计算时间不到一秒钟。确定范围会给我带来很多痛苦，但我仍然认为可以对其进行改进。希望对范围有一些反馈。

Answer 3

我已经重写了要使用的代码，而不是您的代码。只要每一行的第一个单元格的值为"Group A"，它就会将两个行索引之间的所有行加起来。

Dim firstRow As Integer
Dim lastRow As Integer
Dim currentSum As Integer
Dim currentGroup As String

'Change firstRow and lastRow to the row indexes of the cells you're adding
firstRow = 10
lastRow = 13
currentSum = 0
currentGroup = "Group A"

For n = firstRow To lastRow
    If Cells(n, 1).Value = currentGroup Then
        currentSum = currentSum + Application.sum(Range(Cells(n, 1), Cells(n, 50)))
    End If

    'Put the cell name of where you want the value, instead of B3
    Range("B3").Value = currentSum

    'Change currentGroup to the next group here
Next n