VBA - sumifs in for-Schleife - gibt es einen effizienteren Weg?

Question

Ich versuche, ein Makro zu erstellen, das mehrere Summen berechnet und nach Bedingungen auf einem anderen Arbeitsblatt sucht. Dies ist der Code, den ich bisher habe:

Sub SumPerYear() 

Dim NoClients As Long 
NoClients = Worksheets("Temp").Range("A2").End(xlDown).Row - 1 

Sheets("Temp").Activate 

For i = 2 To NoClients + 1 

    'Fill 2015 € in column E 
    Cells(i, 5).Value2 = Application.SumIfs(Worksheets("Q ALL").Range("I:I"), _ 
     Worksheets("Q ALL").Range("A:A"), 2015, _ 
     Worksheets("Q ALL").Range("D:D"), Worksheets("Temp").Range("A" & i).Value2, _ 
     Worksheets("Q ALL").Range("C:C"), True) 

    'Fill 2015 # in column F 
    Cells(i, 6).Value2 = Application.CountIfs(_ 
     Worksheets("Q ALL").Range("A:A"), 2015, _ 
     Worksheets("Q ALL").Range("D:D"), Worksheets("Temp").Range("A" & i).Value2, _ 
     Worksheets("Q ALL").Range("C:C"), True) 

    'Fill 2016 € in column G 
    Cells(i, 7).Value2 = Application.SumIfs(Worksheets("Q ALL").Range("I:I"), _ 
     Worksheets("Q ALL").Range("A:A"), 2016, _ 
     Worksheets("Q ALL").Range("D:D"), Worksheets("Temp").Range("A" & i).Value2, _ 
     Worksheets("Q ALL").Range("C:C"), True) 

    'Fill 2016 # in column H 
    Cells(i, 8).Value2 = Application.CountIfs(_ 
     Worksheets("Q ALL").Range("A:A"), 2016, _ 
     Worksheets("Q ALL").Range("D:D"), Worksheets("Temp").Range("A" & i).Value2, _ 
     Worksheets("Q ALL").Range("C:C"), True) 

    'Fill 2017 € in column I 
    Cells(i, 9).Value2 = Application.SumIfs(Worksheets("Q ALL").Range("I:I"), _ 
     Worksheets("Q ALL").Range("A:A"), 2017, _ 
     Worksheets("Q ALL").Range("D:D"), Worksheets("Temp").Range("A" & i).Value2, _ 
     Worksheets("Q ALL").Range("C:C"), True) 

    'Fill 2017 # in column J 
    Cells(i, 10).Value2 = Application.CountIfs(_ 
     Worksheets("Q ALL").Range("A:A"), 2017, _ 
     Worksheets("Q ALL").Range("D:D"), Worksheets("Temp").Range("A" & i).Value2, _ 
     Worksheets("Q ALL").Range("C:C"), True) 

    'Fill Tot € in column K 
    Cells(i, 11).Value2 = Cells(i, 5) + Cells(i, 7) + Cells(i, 9) 

    'Fill Tot # in column L 
    Cells(i, 12).Value2 = Cells(i, 6) + Cells(i, 8) + Cells(i, 10) 

Next i 

End Sub 

Dieser Code funktioniert, sondern weil es Tausende von Datensätzen sind, dauert es eine lange Zeit in Anspruch. Gibt es eine Möglichkeit, dies effizienter/schneller zu machen?

Vielen Dank für Ihre Eingabe!

Answer 1

Leider funktionieren die Anwendungsverfahren bei einer großen Anzahl von Zellen zu langsam. Sie sollten also etwas Code schreiben, der nicht so schön und einfach ist wie Ihres. Hauptidee ist hier gefangen:

Dim arrA as Variant 'change Variant to your type 
Dim arrCD as Variant 
Dim arr as Variant 
Dim i as long 
Dim k as integer 
Dim NoClients As Long 
NoClients = Worksheets("Temp").Range("A2").End(xlDown).Row - 1 

'assign Ranges to arrays 
'we can't assign non-contiguous range, so we create two arrays 
arrA = Range("A:A") 
arrCD = Range("C:D") 
ReDim arr(UBound(arrA), 3) 
ReDim outArr(NoClients, 5 to 10) 
'loop and fill third merged array 
For i = 1 To UBound(arrA) 
    arr(i, 0) = arrA(i, 1) 
    arr(i, 1) = arrCD(i, 1) 
    arr(i, 2) = arrCD(i, 2) 
Next i 

'the rest of code You just loop through 
For k = 2 To NoClients + 1 'get client 
    For i = 1 To UBound(arr) 'count summuries for him 
     if (arr(i,0) = 2016) and (arr(i,1) = true) and (arr(i,2) = _ 
      Worksheets("Temp").Range("A" & k).Value2) then 
      'sumifs replacement 
      outArr(k, 5) = outArr(k, 5) + Worksheets("Q ALL").Cells(1+i, "I").Value2 
      'countifs replacement 
      outArr(k, 6) = outArr(k, 6) + 1 
     end if 
    Next i 
Next k 

Worksheets("Temp").Range("A2").Value2 = outArr 'prints array on sheet with top left corner at A2