基于唯一 ID 的总和值

Question

刚开始新工作。我正在自动化月末报告，而且我是 VBA 的新手。一直在谷歌上搜索我成功的大部分问题，但我终于遇到了障碍。本质上，我正在从 SAP 下载一些数据，然后我需要从那里构建一个报告。

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

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

到目前为止的步骤：

1. 我将数据表 1 按升序排列。

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

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

到目前为止，这是我在 VBA 中所做的： 子宏_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

结束子

如果我没记错的话，对于 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。插入公式：

（见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 列，因为公式已输入到表 2 的 B 列中。

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

耶数组