使用Excel VBA宏基于列A汇总列B.

Question

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

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

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

Product #    Count
101              7
102              7
107              7
189              9

我是VBA的家伙，所以我很乐意得到任何帮助。

Answer 1

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

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

或者如果你把101放在C1：

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

修改

但是，如果你仍然需要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

Answer 2

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

Answer 3

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

以下是我的数据显示方式：

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

这是代码。它与我的上一个答案具有相同的输出。在新工作簿中对此进行测试，并将测试数据放在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

Answer 4

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

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

Answer 5

基于Sub doIt（）中的代码，是否可以在for each ycle中检索出现次数？

示例：

产品＃101有4次出现

产品＃102有2次出现 ECC ...

Answer 6

我知道它已经很晚了......但是我已经被Sum up column B based on colum C values带到了这里，所以我发布了一个解决方案，采用了我在那里使用的相同的“公式”方法但是适应了这个实际需要

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

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

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