基于唯一ID的总和值

Question

刚刚开始了一项新工作。我正在自动完成月末报告，我是VBA的新成员。一直在成功地搜索我的大部分问题，但我终于遇到了一堵墙。实质上，我正在从SAP下载一些数据，并从那里我需要建立一个报告。

我的问题是：如何在VBA中使用循环进行sumif函数？

数据拉取： Sheet1包含产品代码和购买金额（列A & B）分别。一个产品代码可以有几个购买（几行具有相同的产品代码）。

步骤迄今：

1. 我布置在数据Sheet 1中是按升序排列。

2. 将产品代码的唯一值复制到另一个工作表（工作表2）上。所以Sheet2有一个所有产品的列表（按升序）。

3. 我想获得sheet2列B（每个产品代码）中所有购买的总和。我知道如何使用公式来做到这一点，但我需要尽可能自动化。 （+我在搞清楚了这一点真正感兴趣）

这是我在VBA做了迄今： 子Macro_test（）

Dim tb As Worksheet 
Dim tb2 As Worksheet 
Dim x As Integer 
Dim y As Integer 
Dim lrow As Long 

Set tb = Sheets("sheet1") 
Set tb2 = Sheets("sheet2") 
lrow = tb.Cells(Rows.Count, "A").End(xlUp).Row 

For x = 2 To lrow 
For y = 2 To lrow 
    If tb2.Cells(x, 1).Value = tb.Cells(y, 1).Value Then 
     tb2.Cells(x, 2).Value = tb.Cells(y, 2).Value 
    End If 
Next y 
Next x 

末次

如果我” m没错，对于sheet2 col A中的每个product_code，我循环遍历sheet1中的所有产品代码并找回找到的LAST值，而不是所有值的总和......我明白为什么它不起作用，我只是不知道如何解决它。

任何帮助将不胜感激。谢谢！

Answer 1

本声明将覆盖在每次迭代tb2.Cells(x, 2).Value值：

tb2.Cells(x, 2).Value = tb.Cells(y, 2).Value 

相反，我认为你需要保持增加它：

tb2.Cells(x, 2).Value = tb2.Cells(x, 2).Value + tb.Cells(y, 2).Value 

，但我不喜欢您的双循环外观只使用一个lrow变量来表示两个不同工作表上的“最后一行”，这可能会导致一些问题。

或者，在你的循环中做这样的事情，我认为会避免重复的总和。不过，假设第二个工作最初没有在

' Base our lRow on Sheet2, we don't care how many rows in Sheet1. 
lrow = tb2.Cells(tb2.Rows.Count, 1).End(xlUp).Row 

Dim cl as Range 
Set cl = tb.Cells(2,1) 'Our initial cell value/ID 

For x = 2 to lRow '## Look the rows on Sheet 2 
    '## Check if the cell on Sheet1 == cell on Sheet2 
    While cl.Value = tb2.Cells(x,1).Value 
     '## Add cl.Value t- the tb2 cell: 
     tb2.Cells(x, 2).Value = tb2.Cells(x, 2).Value + cl.Offset(0,1).Value 
     Set cl = cl.Offset(1) '## Reassign to the next Row 
    Wend 
Next 

任何价值，但它会更好省略双回路和简单的使用VBA做以下的1：

1.插入公式：

（请参阅Scott Holtzman's answer）。

这种方法比较好，原因很多，其中最重要的是WorksheetFunction已经被优化了，所以它应该可以在小数据集上运行得更好，但运行时差异可以忽略不计。另一个原因是，重新发明轮子是愚蠢的，除非你有足够的理由这样做，所以在这种情况下，为什么要编写自己的代码版本来完成内置的SumIf已经做了什么，并且是专门设计的？

如果参考数据可能更改，此方法也是理想的，因为单元格公式将根据Sheet1中的数据自动重新计算。

2.评估公式&更换只值：

如果不想保留公式，然后进行简单Value分配可以去除公式，但保留了结果：

With .Range(.Range("B2"), .Range("A2").End(xlDown).Offset(, 1)) 
    .FormulaR1C1 = "=SUMIF(Sheet1!C[-1]:C[-1],RC[-1],Sheet1!C:C)" 
    .Value = .Value 'This line gets rid of the formula but retains the values 
End With 

使用这种方法，如果您将删除Sheet1，因为删除指示将会破坏Sheet2上的公式，或者您希望Sheet2成为“快照”而不是动态求和。

Answer 2

如果您确实需要这种自动化功能，请利用VBA为您提供公式。使用R1C1表示法非常快速简单。

完整代码（测试）：

Dim tb As Worksheet 
Dim tb2 As Worksheet 

Set tb = Sheets("sheet1") 
Set tb2 = Sheets("sheet2") 

Dim lrow As Long 

lrow = tb.Cells(tb.Rows.Count, 1).End(xlUp).Row 

tb.Range("A2:A" & lrow).Copy tb2.Range("A2") 

With tb2 

    .Range("A2").CurrentRegion.RemoveDuplicates 1 

    With .Range(.Range("B2"), .Range("A2").End(xlDown).Offset(, 1)) 
     .FormulaR1C1 = "=SUMIF(Sheet1!C[-1]:C[-1],RC[-1],Sheet1!C:C)" 
    End With 

End With 

注意，与R1C1符号的C和R不是指列或行字母。相反，它们是公式存储在特定工作表上的位置的列和行偏移量。在这种情况下Sheet!C[-1]指片之一的整个A柱，因为该公式被输入到表的B列2

Answer 3

我写了一个整洁的小算法（如果你可以称呼它），你想要做什么他们吐出分组总数到另一张表。基本上它通过第一部分循环获取唯一的名称/标签并将它们存储到一个数组中。然后，如果当前迭代匹配嵌套循环位置的当前迭代，则迭代该数组并且累加值。

Private Sub that() 
    Dim this As Variant 
    Dim that(9, 1) As String 
    Dim rowC As Long 
    Dim colC As Long 

    this = ThisWorkbook.Sheets("Sheet4").UsedRange 
    rowC = ThisWorkbook.Sheets("Sheet4").UsedRange.Rows.Count 
    colC = ThisWorkbook.Sheets("Sheet4").UsedRange.Columns.Count 

    Dim thisname As String 
    Dim i As Long 
    Dim y As Long 
    Dim x As Long 

    For i = LBound(this, 1) To UBound(this, 1) 
     thisname = this(i, 1) 
     For x = LBound(that, 1) To UBound(that, 1) 
      If thisname = that(x, 0) Then 
       Exit For 
      ElseIf thisname <> that(x, 0) And that(x, 0) = vbNullString Then 
       that(x, 0) = thisname 
       Exit For 
      End If 
     Next x 
    Next i 

    For i = LBound(that, 1) To UBound(that, 1) 
     thisname = that(i, 0) 
     For j = LBound(this, 1) To UBound(this, 1) 
      If this(j, 1) = thisname Then 
       thisvalue = thisvalue + this(j, 2) 
      End If 
     Next j 
     that(i, 1) = thisvalue 
     thisvalue = 0 
    Next i 

    ThisWorkbook.Sheets("sheet5").Range(ThisWorkbook.Sheets("Sheet5").Cells(1, 1), ThisWorkbook.Sheets("Sheet5").Cells(rowC, colC)).Value2 = that 

End Sub 

耶阵列