sumif与VBA中的动态列和范围

Question

我想在VBA中使用sumifs函数。并且结果与先前数据粘贴在同一列中。

Answer 1

Twice a SUMIF with Overwrite

• 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列与正确的总数。