0

好的，我有一个简单的问题需要 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，所以我很想得到任何帮助。

4

6 回答 6

3

假设数据在 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
于 2012-04-11T19:42:12.277 回答
2

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

在此处输入图像描述

于 2012-04-11T20:11:00.860 回答
1 
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”。

于 2012-08-01T15:10:16.363 回答
1

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

这是我的数据的样子：

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
于 2012-04-11T21:01:00.917 回答
0

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

例子：

产品 #101 有 4 次出现

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

于 2013-08-06T11:13:35.770 回答
0

我知道已经很晚了......但是我已经被基于列 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

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

是否需要不同的“帮助”列然后查看有关其位置的评论并相应地更改代码

于 2016-04-17T09:15:52.120 回答