使用Excel VBAmacros基于列A求和B列

好吧，我有一个简单的问题，我需要在VBAmacros中的帮助。 我有一个看起来像这样的Excel表格

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

我需要一个基于“产品编号”列的“计数”列的macros。 我完成后，我希望它看起来像这样…

 Product # Count 101 7 102 7 107 7 189 9 

我是VBA的一员，所以我很乐意提供帮助。

Answer 1

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

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

或者如果你把C1放在C1中：

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

编辑

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

 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所build议的那样使用Pivot Table。

Answer 3

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

以下是我的数据：

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

这里是代码。 它和我最后的答案有相同的输出。 在新的工作簿中进行testing，并将testing数据放入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脚本运行时”。

Answer 5

根据Sub doIt（）中的代码，在每个ycle中也可以检索出现的次数？

例：

产品＃101有4次出现

产品＃102有2发生ecc …

Answer 6

我知道这是晚了…但是我已经根据colum C值总结了B列 ，所以我发布了一个解决scheme，使用了我在那里使用的相同的“公式”方法，但是却适应了这个实际需要

 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 

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

应该需要不同的“助手”列，然后看看它的位置和相应的更改代码的意见