VBA SumIfs возвращает оба 0 и правильные результаты

Question

Итак, у меня есть часть кодов, использующих SumIfs для возврата квартальных итогов, с разбивкой по кварталам и годам, с разбивкой по годам. Тем не менее, годовые итоги, итоги Q1, разбивки Q1, итоги Q2, разбивки Q2 возвращают правильные результаты, в то время как разбивки Q3 и Q4 имеют 0, даже если итоги Q3 и Q4 дают верные результаты.

Вот снимок шаблона, где коды должны возвращать значения

Вот мои коды (я знаю, что они не самые лучшие и имеют много возможностей для улучшения но если вы можете, пожалуйста, также помогите улучшить то, как я могу добиться лучших кодов / производительности):

Sub UpdateSnapshot()

'Set up Message Box
    If MsgBox("Update Snapshot?", vbYesNo + vbQuestion + vbDefaultButton2, "Opportunity Snapshot 2020") = vbNo Then
        Exit Sub
    End If

'Declare variables
    Dim wsOpps As Worksheet, wsSnapshot As Worksheet
    Dim r As Integer, c As Integer

    Set wsOpps = ThisWorkbook.Sheets("Opps tracker 2020-2021")
    Set wsSnapshot = ThisWorkbook.Sheets("Snapshot")

    Dim SumRgn As Range 'Total column in Opps worksheet
    Dim CrtYrPrime As Range
    Dim CrtCat As Range
    Dim CrtYrList As Range

    Dim CrtRgnPrime As Range
    Dim CrtRgnCat As Range
    Dim CrtRgnYr As Range

    Dim CrtRgnQ1 As Range 'Range Q1
    Dim CrtRgnQ2 As Range 'Range Q2
    Dim CrtRgnQ3 As Range 'Range Q3
    Dim CrtRgnQ4 As Range 'Range Q4

    Dim CrtQ1Prime As Range
    Dim CrtQ2Prime As Range
    Dim CrtQ3Prime As Range
    Dim CrtQ4Prime As Range

    With wsOpps
        Set SumRgn = .Range("T1:T2000") 'Total column in Opps
        Set CrtRgnPrime = .Range("C1:C2000") 'Prime Model
        Set CrtRgnCat = .Range("K1:K2000") 'Category
        Set CrtRgnYr = .Range("J1:J2000") 'Year

        Set CrtRgnQ1 = .Range("L1:L2000") 'Quarter 1
        Set CrtRgnQ2 = .Range("N1:N2000") 'Quarter 2
        Set CrtRgnQ3 = .Range("P1:P2000") 'Quarter 3
        Set CrtRgnQ4 = .Range("R1:R2000") 'Quarter 4
    End With

    With wsSnapshot
        Set CrtYrPrime = .Range("$A$3") 'Prime Model for Year x
        Set CrtQ1Prime = .Range("$A$22")
        Set CrtQ2Prime = .Range("$A$41")
        Set CrtQ3Prime = .Range("$A$60")
        Set CrtQ4Prime = .Range("$A$79")

        Set CrtCat = .Range("$B$1") 'Category
        Set CrtYrList = .Range("$A$1") 'Year list

    End With

'IMPORTANT -- Turn off events
    Application.EnableEvents = False

'Clear old data in Worksheet Snapshot
    wsSnapshot.Range("B3:K20, B22:K39, B41:K58, B60:K77, B79:K96").ClearContents

'Yearly breakdown
    For r = 3 To 19
        For c = 2 To 11
            wsSnapshot.Cells(r, c) _
                = Application.WorksheetFunction.SumIfs(SumRgn, CrtRgnPrime, CrtYrPrime.Offset(r - 3, 0), _
                    CrtRgnCat, CrtCat.Offset(0, c - 2), CrtRgnYr, CrtYrList)
        Next c
    Next r
'Yearly Total
    For r = 20 To 20
        For c = 2 To 11
            wsSnapshot.Cells(r, c) _
                = Application.WorksheetFunction.SumIfs(SumRgn, CrtRgnCat, CrtCat.Offset(0, c - 2), CrtRgnYr, CrtYrList)
        Next c
    Next r

'Q1 breakdown
    For r = 22 To 38
        For c = 2 To 11
            wsSnapshot.Cells(r, c) _
                = Application.WorksheetFunction.SumIfs(CrtRgnQ1, CrtRgnPrime, CrtQ1Prime.Offset(r - 3, 0), _
                    CrtRgnCat, CrtCat.Offset(0, c - 2), CrtRgnYr, CrtYrList)
        Next c
    Next r
'Q2 breakdown
    For r = 41 To 57
        For c = 2 To 11
            wsSnapshot.Cells(r, c) _
                = Application.WorksheetFunction.SumIfs(CrtRgnQ2, CrtRgnPrime, CrtQ2Prime.Offset(r - 3, 0), _
                    CrtRgnCat, CrtCat.Offset(0, c - 2), CrtRgnYr, CrtYrList)
        Next c
    Next r
'Q3 breakdown
    For r = 60 To 76
        For c = 2 To 11
            wsSnapshot.Cells(r, c) _
                = Application.WorksheetFunction.SumIfs(CrtRgnQ3, CrtRgnPrime, CrtQ3Prime.Offset(r - 3, 0), _
                    CrtRgnCat, CrtCat.Offset(0, c - 2), CrtRgnYr, CrtYrList)
        Next c
    Next r
'Q4 breakdown
    For r = 79 To 95
        For c = 2 To 11
            wsSnapshot.Cells(r, c) _
                = Application.WorksheetFunction.SumIfs(CrtRgnQ4, CrtRgnPrime, CrtQ4Prime.Offset(r - 3, 0), _
                    CrtRgnCat, CrtCat.Offset(0, c - 2), CrtRgnYr, CrtYrList)
        Next c
    Next r

'Q1 Total
    For r = 39 To 39
        For c = 2 To 11
            wsSnapshot.Cells(r, c) _
                = Application.WorksheetFunction.SumIfs(CrtRgnQ1, CrtRgnCat, CrtCat.Offset(0, c - 2), CrtRgnYr, CrtYrList)
        Next c
    Next r
'Q2 Total
    For r = 58 To 58
        For c = 2 To 11
            wsSnapshot.Cells(r, c) _
                = Application.WorksheetFunction.SumIfs(CrtRgnQ2, CrtRgnCat, CrtCat.Offset(0, c - 2), CrtRgnYr, CrtYrList)
        Next c
    Next r
'Q3 Total
    For r = 77 To 77
        For c = 2 To 11
            wsSnapshot.Cells(r, c) _
                = Application.WorksheetFunction.SumIfs(CrtRgnQ3, CrtRgnCat, CrtCat.Offset(0, c - 2), CrtRgnYr, CrtYrList)
        Next c
    Next r
'Q4 Total
    For r = 96 To 96
        For c = 2 To 11
            wsSnapshot.Cells(r, c) _
                = Application.WorksheetFunction.SumIfs(CrtRgnQ4, CrtRgnCat, CrtCat.Offset(0, c - 2), CrtRgnYr, CrtYrList)
        Next c
    Next r

'IMPORTANT -- Turn on events
    Application.EnableEvents = True

End Sub

Я не знаю, почему, но Q1, Q2 имеют те же самые формулы с Q3 и Q4, но Q3 , Q4 почему-то не работает.

Это на моем листе "Снимок":

Private Sub Worksheet_Change(ByVal Target As Range)
 If Target.Address = "$A$1" Then
    Call UpdateSnapshot
 End If
End Sub

Пожалуйста, сообщите! Любая помощь высоко ценится! Спасибо!

Answer 1

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

Option Explicit

Sub update2()

   'Set up Message Box
    If MsgBox("Update Snapshot?", vbYesNo + vbQuestion + vbDefaultButton2, "Opportunity Snapshot 2020") = vbNo Then
        Exit Sub
    End If

    Dim wb As Workbook, wsSnapshot As Worksheet, wsOpps As Worksheet
    Dim r As Long, c As Long, i As Integer, rowTotal As Long
    Dim CrtRgnPrime As Range, CrtRgnCat As Range
    Dim CrtYrList As Range, CrtCat As Range, CrtRgnYr As Range
    Dim CrtRgnQu(4) As Range, CrtQuPrime(4) As Range

    Set wb = ThisWorkbook
    Set wsSnapshot = wb.Sheets("Snapshot")
    Set wsOpps = wb.Sheets("Opps tracker 2020-2021")

    With wsOpps
        'Set SumRgn = .Range("T1:T2000") 'Total column in Opps
        Set CrtRgnPrime = .Range("C1:C2000") 'Prime Model
        Set CrtRgnCat = .Range("K1:K2000") 'Category
        Set CrtRgnYr = .Range("J1:J2000")

        ' define ranges for Year, Qu1-4
        Set CrtRgnQu(0) = .Range("T1:T2000") ' Year
        Set CrtRgnQu(1) = .Range("L1:L2000") ' Qu1
        Set CrtRgnQu(2) = .Range("N1:N2000") ' Qu2
        Set CrtRgnQu(3) = .Range("P1:P2000") ' Qu3
        Set CrtRgnQu(4) = .Range("R1:R2000") ' Qu4
    End With

    With wsSnapshot
        Set CrtCat = .Range("$B$1") 'Category
        Set CrtYrList = .Range("$A$1") 'Year list
        Set CrtQuPrime(0) = .Range("A3") ' Total
    End With

    ' Q1 to Q4 offset from Total
    For i = 1 To 4
        Set CrtQuPrime(i) = CrtQuPrime(i - 1).Offset(19, 0)
    Next

    ' Total, Q1 to Q4
    Application.EnableEvents = False
    For i = 0 To 4

        ' clear range
        CrtQuPrime(i).Offset(0, 1).Resize(18, 1).ClearContents

        For r = 1 To 17
            For c = 1 To 10
                 CrtQuPrime(i).Offset(r - 1, c) = Application.WorksheetFunction.SumIfs( _
                 CrtRgnQu(i), CrtRgnPrime, CrtQuPrime(i).Offset(r - 1, 0), _
                 CrtRgnCat, _
                 CrtCat.Offset(0, c - 1), _
                 CrtRgnYr, CrtYrList)
            Next
        Next

        ' total
        For c = 1 To 10
            CrtQuPrime(i).Offset(17, c) = Application.WorksheetFunction.SumIfs( _
                CrtRgnQu(i), CrtRgnCat, CrtCat.Offset(0, c - 1), CrtRgnYr, CrtYrList)
        Next

    Next
    Application.EnableEvents = True
    MsgBox "Updated"
End Sub