1。插入公式：

Question

刚刚开始一份新工作。我正在自动化月末报告，而且我是VBA的新人。谷歌搜索我的大部分问题都取得了成功，但我终于陷入困境。本质上，我从SAP下载了一些数据，然后我需要构建一个报告。

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

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

到目前为止的步骤：

我将数据表1排列为升序。
将产品代码的唯一值复制到另一张纸上（sheet2）。所以Sheet2有一个所有产品的清单（按升序排列）。
我想获得sheet2列B中所有购买的总和（每个产品代码）。我知道如何使用公式来做到这一点，但我需要尽可能地自动化。（+我真的有兴趣搞清楚这一点）

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

End Sub

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

非常感谢任何帮助。谢谢！

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变量来表示＆＃34;最后一行＆＃34;在两个不同的工作表上，这可能会导致一些问题。

或者，在你的循环中做这样的事情，我认为这将避免重复的总和。仍然，假设第二个工作表最初没有任何值

' 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。评估公式和＆amp;仅替换值：

如果您不想保留公式，那么简单的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成为＆＃34;快照＆＃34;而不是动态总和。

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]引用第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

Yay数组

基于唯一ID

3 个答案:

1。插入公式：

2。评估公式和＆amp;仅替换值：