sumif с динамическим столбцом и диапазоном в VBA

Question

Я хочу использовать функцию sumifs в VBA. И результат вставьте в тот же столбец, что и предыдущие данные.

Answer 1

Вы можете использовать SumIfs в VBA через объект Application или WorksheetFunction со ссылками на диапазон стилей VBA. Вы захотите использовать его только один раз для каждой пары значений столбца A и B. Если вы используете его один раз, а затем переходите к другой строке с той же парой значений столбца A и столбца B, вы не сможете использовать его снова без получения ложных результатов из-за изменений, которые вы сделали в первый раз.

Однако эти ложные результаты в порядке, если вы все равно просто собираетесь их удалить, а RemoveDuplicates удаляет снизу вверх, оставляя самые верхние пары столбца A и столбца B с правильными итогами.

Answer 2

Дважды SUMIF с перезаписью

• Загрузка рабочей книги (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