Excel vba, сделать SUMIF с критериями динамического диапазона

Question

Я написал код в VBA для выполнения некоторых автоматизированных задач.Sheet1 - это форма, а Sheet2 - это база данных, в которой хранятся эти данные.Я также хотел бы иметь Button при нажатии, чтобы сделать SUMIF в последнем ряду.

SUMIF(Column containing search values, value to search for, column conaintining items to add)

Мой код такой, как показано ниже

Dim ws1, ws2 As Worksheet


Set ws1 = ThisWorkbook.Sheets("DataBase")
Set ws2 = ThisWorkbook.Sheets("Emails")
Set rngr = ws2.Range("C17")
Set rngs = ws2.Range("C18")
Set rngt = ws2.Range("C19")
Set rngu = ws2.Range("C20")
Set rngy = ws2.Range("C21")
Set rngw = ws2.Range("C24")
Set rngz = ws2.Range("C25")


h = ws2.Range("C1")
i = ws2.Range("C2")
j = ws2.Range("C3")
tot1 = "=RC[-1]-RC[-2]"
tot2 = "=SUM(RC[-5]:RC[-1])"
tot3 = "=SUM(RC[-5]:RC[-1])"
tot4 = "=SUM(RC[-2]:RC[-1])"
tot = "=SUM(RC[-16]+RC[-10]+RC[-4]+RC[-1])"
k = ws2.Range("C5")
l = ws2.Range("C6")
m = ws2.Range("C7")
N = ws2.Range("C8")
f = ws2.Range("C11")
o = ws2.Range("C12")
p = ws2.Range("C13")
G = ws2.Range("C15")
r = Application.WorksheetFunction.VLookup(rngr, ws2.Range("E18:F19").Value, 2, False)
s = Application.WorksheetFunction.VLookup(rngs, ws2.Range("E18:F19").Value, 2, False)
t = Application.WorksheetFunction.VLookup(rngt, ws2.Range("E18:F19").Value, 2, False)
u = Application.WorksheetFunction.VLookup(rngu, ws2.Range("E18:F19").Value, 2, False)
y = Application.WorksheetFunction.VLookup(rngy, ws2.Range("E18:F19").Value, 2, False)
w = Application.WorksheetFunction.VLookup(rngw, ws2.Range("E25:F26").Value, 2, False)
Z = Application.WorksheetFunction.VLookup(rngz, ws2.Range("E25:F26").Value, 2, False)


lastRow = ws1.Range("A" & Rows.Count).End(xlUp).Row + 1
last_day = ws1.Range("A" & Rows.Count).End(xlUp).Value
col_search = ws1.Range("A3", Range("A" & Rows.Count).End(xlUp))
col_contain = ws1.Range("G3", Range("G" & Rows.Count).End(xlUp))

ws1.Cells(lastRow, 7).Value = Application.WorksheetFunction.SumIf( col_search, "=" & last_day, col_contain)
ws1.Cells(lastRow, 1).Value = Date
ws1.Cells(lastRow, 2) = h
ws1.Cells(lastRow, 3) = i
ws1.Cells(lastRow, 4) = j
ws1.Cells(lastRow, 5) = k
ws1.Cells(lastRow, 6) = l
ws1.Cells(lastRow, 8) = N
ws1.Cells(lastRow, 9) = tot1
ws1.Cells(lastRow, 9).Font.Bold = True
ws1.Cells(lastRow, 10) = f
ws1.Cells(lastRow, 11) = o
ws1.Cells(lastRow, 12) = p
ws1.Cells(lastRow, 13) = G
ws1.Cells(lastRow, 15) = tot2
ws1.Cells(lastRow, 15).Font.Bold = True
ws1.Cells(lastRow, 16) = r
ws1.Cells(lastRow, 17) = s
ws1.Cells(lastRow, 18) = t
ws1.Cells(lastRow, 19) = u
ws1.Cells(lastRow, 20) = y
ws1.Cells(lastRow, 21) = tot3
ws1.Cells(lastRow, 21).Font.Bold = True
ws1.Cells(lastRow, 22) = w
ws1.Cells(lastRow, 23) = Z
ws1.Cells(lastRow, 24) = tot4
ws1.Cells(lastRow, 24).Font.Bold = True
ws1.Cells(lastRow, 25) = tot
ws1.Cells(lastRow, 25).Font.Bold = True


Dim TargetColumns As Variant
Dim SourceCells As Range
Dim rCell As Range
Dim rAddToCell As Range
Dim x As Long

TargetColumns = Array(20, 23) 'Column numbers to place into.
Set SourceCells = ThisWorkbook.Worksheets("Emails").Range("C22,C26")

'Look at each cell in turn.
For Each rCell In SourceCells

    'Find the last cell in the correct column.
    Set rAddToCell = LastCell(ThisWorkbook.Worksheets("DataBase"), CLng(TargetColumns(x)))

    'If there's already a comment then delete it first
    'Then add value from SourceCell into comment in Target column.
    With rAddToCell
        If HasComment(rAddToCell) Then
            .ClearComments
        End If
        .AddComment
        .Comment.Text Text:=rCell.Value
    End With

    x = x + 1
Next rCell

End Sub

Значение для поиска будетбыть последним свиданием, поэтому практически из того, что у меня есть

last_day = ws1.Range("A" & Rows.Count).End(xlUp).Row

Мой фактический формат SUMIF неверен, так как я не получаю желаемого результата.Возможно, моя логика неверна или сам код неправильный

ws1.Cells(lastRow, 7).Value = Application.WorksheetFunction.SumIfs(col_search, last_day, col_contain)

Ошибка:

Run-time error 1004
Application-defined or object-defined error

Любое предложение приветствуется и спасибо

Answer 1

Измените его на

last_day = ws1.Range("A" & ws1.Rows.Count).End(xlUp).Value

в противном случае вы получите номер строки последней использованной строки, а не ее значение.

Кроме того, вы смешали SumIf и SumIfs, которые имеют другой порядок синтаксиса.

---

SumIfs (несколько критериев)

И в соответствии с WorksheetFunction.SumIfs метод синтаксис

SumIfs(RangeToSum, Criteria_range1, Criteria1, Criteria_range2, Criteria2, …)

поэтому я считаю, что вам нужно переключить параметры и добавить "=" & в критерии

SumIfs(col_contain, col_search, "=" & last_day)

• col_contain = столбец для суммирования
• col_search = столбец для проверки по критериям

---

SumIf (единичные критерии)

Или вы используете метод WorksheetFunction.SumIf , где синтаксис

SumIf(Criteria_range, Criteria, RangeToSum)

Любое, что вы можете использовать

SumIf( col_search, "=" & last_day, col_contain)

---

Обратите внимание, что я рекомендую немного уменьшить код и удалить ненужные переменные. Также используйте значимые имена переменных, такие как wsDB и wsEmails, которые намного легче читать и понимать, чем бессмысленные переменные или однобуквенные переменные, такие как a, b, c…

Также рекомендуется активировать Option Explicit: в редакторе VBA перейдите на Инструменты › Параметры › Требуется объявление переменных и правильно объявить все переменные.

Option Explicit

Sub YourProcedureName()
    Dim wsDB As Worksheet
    Set wsDB = ThisWorkbook.Sheets("DataBase")

    Dim wsEmails As Worksheet
    Set wsEmails = ThisWorkbook.Sheets("Emails")

    'm = wsEmails.Range("C7") 'was not used at all

    With wsDB
        Dim NextFreeRow As Long
        NextFreeRow = .Range("A" & .Rows.Count).End(xlUp).Row + 1

        Dim Last_Day As String
        Last_Day = .Range("A" & .Rows.Count).End(xlUp).Value

        Dim Col_Search As Range
        Col_Search = .Range("A3", .Range("A" & .Rows.Count).End(xlUp))

        Dim Col_Contain As Range
        Col_Contain = .Range("G3", .Range("G" & .Rows.Count).End(xlUp))
    End With

    With wsEmails
        wsDB.Cells(NextFreeRow, 7).Value = Application.WorksheetFunction.SumIf(Col_Search, "=" & Last_Day, Col_Contain)
        wsDB.Cells(NextFreeRow, 1).Value = Date
        wsDB.Cells(NextFreeRow, 2) = .Range("C1")
        wsDB.Cells(NextFreeRow, 3) = .Range("C2")
        wsDB.Cells(NextFreeRow, 4) = .Range("C3")
        wsDB.Cells(NextFreeRow, 5) = .Range("C5")
        wsDB.Cells(NextFreeRow, 6) = .Range("C6")
        wsDB.Cells(NextFreeRow, 8) = .Range("C8")
        wsDB.Cells(NextFreeRow, 9) = "=RC[-1]-RC[-2]"
        wsDB.Cells(NextFreeRow, 9).Font.Bold = True
        wsDB.Cells(NextFreeRow, 10) = .Range("C11")
        wsDB.Cells(NextFreeRow, 11) = .Range("C12")
        wsDB.Cells(NextFreeRow, 12) = .Range("C13")
        wsDB.Cells(NextFreeRow, 13) = .Range("C15")
        wsDB.Cells(NextFreeRow, 15) = "=SUM(RC[-5]:RC[-1])"
        wsDB.Cells(NextFreeRow, 15).Font.Bold = True
        wsDB.Cells(NextFreeRow, 16) = Application.WorksheetFunction.VLookup(.Range("C17"), .Range("E18:F19").Value, 2, False)
        wsDB.Cells(NextFreeRow, 17) = Application.WorksheetFunction.VLookup(.Range("C18"), .Range("E18:F19").Value, 2, False)
        wsDB.Cells(NextFreeRow, 18) = Application.WorksheetFunction.VLookup(.Range("C19"), .Range("E18:F19").Value, 2, False)
        wsDB.Cells(NextFreeRow, 19) = Application.WorksheetFunction.VLookup(.Range("C20"), .Range("E18:F19").Value, 2, False)
        wsDB.Cells(NextFreeRow, 20) = Application.WorksheetFunction.VLookup(.Range("C21"), .Range("E18:F19").Value, 2, False)
        wsDB.Cells(NextFreeRow, 21) = "=SUM(RC[-5]:RC[-1])"
        wsDB.Cells(NextFreeRow, 21).Font.Bold = True
        wsDB.Cells(NextFreeRow, 22) = Application.WorksheetFunction.VLookup(.Range("C24"), .Range("E25:F26").Value, 2, False)
        wsDB.Cells(NextFreeRow, 23) = Application.WorksheetFunction.VLookup(.Range("C25"), .Range("E25:F26").Value, 2, False)
        wsDB.Cells(NextFreeRow, 24) = "=SUM(RC[-2]:RC[-1])"
        wsDB.Cells(NextFreeRow, 24).Font.Bold = True
        wsDB.Cells(NextFreeRow, 25) = "=SUM(RC[-16]+RC[-10]+RC[-4]+RC[-1])"
        wsDB.Cells(NextFreeRow, 25).Font.Bold = True
    End With


    Dim TargetColumns As Variant
    TargetColumns = Array(20, 23) 'Column numbers to place into.

    Dim SourceCells As Range
    Set SourceCells = ThisWorkbook.Worksheets("Emails").Range("C22,C26")

    Dim x As Long

    'Look at each cell in turn.
    Dim rCell As Range
    For Each rCell In SourceCells

        'Find the last cell in the correct column.
        Dim rAddToCell As Range
        Set rAddToCell = LastCell(ThisWorkbook.Worksheets("DataBase"), CLng(TargetColumns(x)))

        'If there's already a comment then delete it first
        'Then add value from SourceCell into comment in Target column.
        With rAddToCell
            If HasComment(rAddToCell) Then
                .ClearComments
            End If
            .AddComment
            .Comment.Text Text:=rCell.Value
        End With

        x = x + 1
    Next rCell

End Sub