在VBA中具有动态列和范围的sumif

Question

我想在VBA中使用sumifs函数。然后将结果粘贴到与先前数据相同的列中。

Answer 1

两次具有覆盖的SUMIF

• Workbook Download （Dropbox）
• 找不到SUMIFS的任何迹象，所以我这样做好像 SUMIF两次：
  对于列A和C，以及列B和D。

Option Explicit

Sub SumUnique(UniqueFirstCell As Range, ValueFirstCell As Range)

    Dim rng As Range      ' Unique Last Used Cell
    Dim dict As Object    ' Dictionary
    Dim key As Variant    ' Dictionary Key Counter (For Each Control Variable)
    Dim vntU As Variant   ' Unique Range Array
    Dim vntV As Variant   ' Value Range Array
    Dim vntUT As Variant  ' Unique Array
    Dim vntVT As Variant  ' Value Array
    Dim curV As Variant   ' Current Value
    Dim NorS As Long      ' Source Number of Rows
    Dim NorT As Long      ' Target Number of Rows
    Dim i As Long         ' Source/Target Row Counter

    ' Copy Unique Range to Unique Range Array.
    With UniqueFirstCell
        Set rng = .Worksheet.Columns(.Column) _
                .Find("*", , xlFormulas, , , xlPrevious)
        Set rng = .Resize(rng.Row - .Row + 1)
    End With
    vntU = rng

    ' Copy Value Range to Value Range Array.
    With ValueFirstCell
        Set rng = .Worksheet.Columns(.Column) _
                .Find("*", , xlFormulas, , , xlPrevious)
        Set rng = .Resize(rng.Row - .Row + 1)
    End With
    vntV = rng

    ' Create Unique Values and SumIf Values in Dictionary.
    Set dict = CreateObject("Scripting.Dictionary")
    NorS = UBound(vntU)
    For i = 1 To NorS
        curV = vntU(i, 1)
        If curV <> "" Then
            dict(curV) = dict(curV) + vntV(i, 1)
        End If
    Next
    NorT = dict.Count

    ' Resize Unique and Value Arrays to Target Number of Rows.
    ReDim vntUT(1 To NorT, 1 To 1)
    ReDim vntVT(1 To NorT, 1 To 1)

    i = 0
    For Each key In dict.keys
        i = i + 1
        ' Write Dictionary Keys to Unique Array.
        vntUT(i, 1) = key
        ' Write Dictionary Values to Value Array.
        vntVT(i, 1) = dict(key)
    Next

    ' Copy Unique Array to Target Unique Range.
    With UniqueFirstCell
        Set rng = .Resize(.Worksheet.Rows.Count - .Row + 1)
        rng.ClearContents
        Set rng = .Resize(NorT)
    End With
    rng = vntUT

    ' Copy Value Array to Target Value Range.
    With ValueFirstCell
        Set rng = .Resize(.Worksheet.Rows.Count - .Row + 1)
        rng.ClearContents
        Set rng = .Resize(NorT)
    End With
    rng = vntVT

End Sub

Sub Uni()
    Uni1
    Uni2
End Sub

Sub Uni1()
    Const cUni As String = "A2"
    Const cVal As String = "C2"

    With ThisWorkbook.Worksheets("Sheet1")
        SumUnique .Range(cUni), .Range(cVal)
    End With

End Sub

Sub Uni2()
    Const cUni As String = "B2"
    Const cVal As String = "D2"

    With ThisWorkbook.Worksheets("Sheet1")
        SumUnique .Range(cUni), .Range(cVal)
    End With

End Sub

我创建了两个命令按钮，并将以下代码放入工作表模块中：

Option Explicit

Private Sub cmdRevert_Click()
    [A2:D31] = [J2:M31].Value
End Sub

Private Sub cmdUnique_Click()
    Uni
End Sub

Answer 2

您可以通过带有VBA样式范围引用的Application或WorksheetFunction对象在VBA中使用SumIfs。您将只想对A列和B列的每对值使用一次。如果只使用一次然后循环到具有相同的A列和B列对值的另一行，则由于第一次更改，因此不能再次使用它而不会得到错误的结果。

但是，如果您仍然要删除它们，并且从下往上删除RemoveDuplicates，则将这些错误的结果都可以，而使最上面的A列和B列对具有正确的总数。