Суммируйте значения разными ключами

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