使用 Excel VBA 宏基于 A 列求和 B 列

Sum Column B based on Column A using Excel VBA Macro

提问by Stephan Daudt

OK, I have a simple problem that I need help with in a VBA Macro. I have an excel sheet that looks like this...

好的，我有一个简单的问题需要在 VBA 宏中获得帮助。我有一个看起来像这样的excel表......

Product #     Count
101              1
102              1
101              2
102              2
107              7
101              4
101              4
189              9

I need a macro that adds up the "count" column based on the Product Number Column. I want it to over all look like this after I am done...

我需要一个根据产品编号列添加“计数”列的宏。我希望它在我完成后看起来像这样......

Product #    Count
101              7
102              7
107              7
189              9

I am an amiture to VBA so I would love any help I can get.

我是 VBA 的朋友，所以我希望能得到任何帮助。

回答by assylias

Assuming the data is in columns A and B, you can do it with a formula:

假设数据在 A 列和 B 列中，您可以使用公式：

=SUMIF(A:A,101,B:B)

Or if you put 101 in C1:

或者，如果您将 101 放入 C1：

=SUMIF(A:A,C1,B:B)

EDIT

编辑

However if you still require VBA, here is my (quick and dirty) proposal - I use a dictionary to keep track of the sum for each item.

但是，如果您仍然需要 VBA，这是我的（快速而肮脏的）建议 - 我使用字典来跟踪每个项目的总和。

Sub doIt()

  Dim data As Variant
  Dim i As Long
  Dim countDict As Variant
  Dim category As Variant
  Dim value As Variant

  Set countDict = CreateObject("Scripting.Dictionary")

  data = ActiveSheet.UsedRange 'Assumes data is in columns A/B

  'Populate the dictionary: key = category / Item = count
  For i = LBound(data, 1) To UBound(data, 1)
    category = data(i, 1)
    value = data(i, 2)
    If countDict.exists(category) Then
      countDict(category) = countDict(category) + value 'if we have already seen that category, add to the total
    Else
      countDict(category) = value 'first time we find that category, create it
    End If
  Next i

  'Copy dictionary into an array
  ReDim data(1 To countDict.Count, 1 To 2) As Variant

  Dim d As Variant
  i = 1
  For Each d In countDict
    data(i, 1) = d
    data(i, 2) = countDict(d)
    i = i + 1
  Next d

  'Puts the result back in the sheet in column D/E, including headers
  With ActiveSheet
    .Range("D1").Resize(UBound(data, 1), UBound(data, 2)) = data
  End With

End Sub

回答by Joseph

The easiest thing is to use a Pivot Table in this case as Tim suggested.

在这种情况下，最简单的方法是按照 Tim 的建议使用数据透视表。

回答by Joseph

Here is a VBA solution that uses multidimensional arrays. I noticed you said you are a bit new to VBA so I tried to put some meaningful comments in there. One thing that might look strange is when I redimension the arrays. That's because when you have multidimensional arrays you can only ReDim the last dimension in the array when you use the Preserve keyword.

这是一个使用多维数组的 VBA 解决方案。我注意到你说你对 VBA 有点陌生，所以我试着在那里发表一些有意义的评论。可能看起来很奇怪的一件事是当我重新调整数组的大小时。这是因为当您拥有多维数组时，您只能在使用 Preserve 关键字时重新调整数组中的最后一个维度。

Here is how my data looked:

这是我的数据的外观：

Product Count
101     1
102     1
101     2
102     2
107     7
101     4
101     4
189     9

And here is the code. It has the same output as my last answer. Test this in a new workbook and put the test data in Sheet1 with headers.

这是代码。它的输出与我上一个答案相同。在新的工作簿中对此进行测试，并将测试数据放在带有标题的 Sheet1 中。

Option Explicit

Sub testFunction()
    Dim rng As Excel.Range
    Dim arrProducts() As String
    Dim i As Long

    Set rng = Sheet1.Range("A2:A9")

    arrProducts = getSumOfCountArray(rng)

    Sheet2.Range("A1:B1").Value = Array("Product", "Sum of Count")

    ' go through array and output to Sheet2
    For i = 0 To UBound(arrProducts, 2)
        Sheet2.Cells(i + 2, "A").Value = arrProducts(0, i)
        Sheet2.Cells(i + 2, "B").Value = arrProducts(1, i)
    Next

End Sub

' Pass in the range of the products
Function getSumOfCountArray(ByRef rngProduct As Excel.Range) As String()
    Dim arrProducts() As String
    Dim i As Long, j As Long
    Dim index As Long

    ReDim arrProducts(1, 0)

    For j = 1 To rngProduct.Rows.Count
        index = getProductIndex(arrProducts, rngProduct.Cells(j, 1).Value)
        If (index = -1) Then
            ' create value in array
            ReDim Preserve arrProducts(1, i)
            arrProducts(0, i) = rngProduct.Cells(j, 1).Value ' product name
            arrProducts(1, i) = rngProduct.Cells(j, 2).Value ' count value
            i = i + 1
        Else
            ' value found, add to id
            arrProducts(1, index) = arrProducts(1, index) + rngProduct.Cells(j, 2).Value
        End If
    Next

    getSumOfCountArray = arrProducts
End Function

Function getProductIndex(ByRef arrProducts() As String, ByRef strSearch As String) As Long
    ' returns the index of the array if found
    Dim i As Long
    For i = 0 To UBound(arrProducts, 2)
        If (arrProducts(0, i) = strSearch) Then
            getProductIndex = i
            Exit Function
        End If
    Next

    ' not found
    getProductIndex = -1
End Function

回答by Freelancer

Sub BestWaytoDoIt()

Dim i As Long                    ' Loop Counter
Dim int_DestRwCntr As Integer    ' Dest. sheet Counter
Dim dic_UniquePrd As Scripting.Dictionary
Set dic_UniquePrd = New Scripting.Dictionary

For i = 2 To Sheet1.Range("A" & Sheet1.Cells.Rows.Count - 1).End(xlUp).Row
    If dic_UniquePrd.exist(Sheet1.Range("A" & i).Value) <> True Then
        dic_UniquePrd.Add Sheet1.Range("A" & i).Value, DestRwCntr
        sheet2.Range("A" & int_DestRwCntr).Value = Sheet1.Range("A" & i).Value
        sheet2.Range("B" & int_DestRwCntr).Value = Sheet1.Range("B" & i).Value
    Else
        sheet2.Range("A" & dic_UniquePrd.Item(Sheet1.Range("A" & i).Value)).Value = sheet2.Range("B" & dic_UniquePrd.Item(Sheet1.Range("A" & i).Value)).Value + Sheet1.Range("B" & i).Value
    End If
Next
End Sub

This will serve the purpose.. Only thing to remember is to activate "Microsoft Scripting Runtimes" in references.

这将达到目的.. 唯一要记住的是在参考中激活“Microsoft Scripting Runtimes”。

回答by user1579247

Based the code in Sub doIt(), is possible in the for Each ycle to retrive also the number of occurence?

基于 Sub doIt() 中的代码，是否可以在 for Each ycle 中检索出现次数？

Example:

例子：

Product # 101 have 4 occurence

产品 # 101 有 4 次出现

Product # 102 have 2 occurence ecc...

产品 # 102 有 2 次出现 ecc...

回答by user3598756

I know it' late... but I've been brought here by Sum up column B based on colum C valuesand so I post a solution with the same "formula" approach I used there but adapted to this actual need

我知道已经晚了......但是我已经根据列 C 值总结 B 列将我带到这里，所以我发布了一个解决方案，该解决方案与我在那里使用的相同“公式”方法但适应了这种实际需要

Option Explicit

Sub main()

    With ActiveSheet
        With .Range("A:B").Resize(.cells(.Rows.Count, 1).End(xlUp).row) '<== here adjust "A:B" to whatever colums range you need
            With .Offset(1).Resize(.Rows.Count - 1)
                .Offset(, .Columns.Count).Resize(, 1).FormulaR1C1 = "=SUMIF(C1,RC1,C2)" ' "helper" column: it's the 1st column right of data columns (since ".Offset(, .Columns.Count)")
                .Columns(2).Value = .Offset(, .Columns.Count).Resize(, 1).Value 'update "count" with sum-up from "helper" column

                With .Offset(, .Columns.Count).Resize(, 1) ' reference to "helper" column
                    .FormulaR1C1 = "=IF(countIF(R1C1:RC1,RC1)=1,1,"""")" ' locate Product# repetition with blank cells
                    .Value = .Value 'fix values
                    .SpecialCells(xlCellTypeBlanks).EntireRow.Delete 'delete rows corresponding to blank cells
                    .ClearContents ' clear "helper" column
                End With
            End With
        End With
    End With

    End Sub

it makes use of a "helper" columns, which I assumed could be the one adjacent to the last data columns (i.e.: if data columns are "A:B" then helper column is "C")

它使用了一个“辅助”列，我认为它可能是与最后一个数据列相邻的列（即：如果数据列是“A:B”，那么辅助列是“C”）

should different "helper" column be needed then see comments about how it's located and change code accordingly

如果需要不同的“助手”列，然后查看有关它如何定位的注释并相应地更改代码