VBA loops in een array en geheugenprobleem

[Excelbat]

Zie bijlage. Via VBA bereken ik een sommen.als, gemiddelden.als en aantallen.als.
(Ik weet dat dit makkelijker kan met standaard excelformules, maar ik heb dit via VBA gedaan, omdat ik VBA meer en meer onder de knie wil krijgen).
Zolang ik de te berekenen range lager hou dan ongeveer 2000 rijen, gaat het goed.
Bij 2500 rijen wordt de Macro eruit geknald vanwege (denk ik) geheugenprobleem.
Hoe kan ik dit geheugenprobleem oplossen?

Sub Excelbat()
Dim j As Integer
Dim xyz As Integer

Tabelle1.Cells(1, 13).CurrentRegion.ClearContents
Tabelle1.Cells(1, 23).CurrentRegion.ClearContents
Application.Wait Now + #12:00:02 AM#
sn = Range("a1:h2000")

'2000 rijen en 7 kolommen
ReDim sp(2000, 7)
  
'Vanaf rij 2 t/m 2000
    For j = 2 To UBound(sn)
        sp(j, 1) = sn(j, 1)
        sp(j, 2) = sn(j, 2)
        sp(j, 3) = sn(j, 4)
 'Hier kijken we wat er opgeteld moet worden, alweer in rij 2 t/m 2000, resultaat komt in kolom 4 en 5 van sp
            For xyz = 2 To UBound(sn)
                If sn(xyz, 1) = sn(j, 1) And sn(xyz, 2) = sn(j, 2) Then sp(j, 4) = sp(j, 4) + sn(xyz, 4)
                If sn(xyz, 1) = sn(j, 1) And sn(xyz, 2) = sn(j, 2) Then sp(j, 5) = sp(j, 5) + 1
            Next
'Hier kijken we of kolom 4 en 5 en 6 van sp ingevuld gaat worden of niet
        sp(j, 6) = sp(j, 4) / sp(j, 5)
    Next
'Hier gooien we het resultaat naar de sheet toe (begint in cel 21 omdat j begonnen is met 2:
Tabelle1.Cells(1, 13).Resize(UBound(sp), 7) = sp
Tabelle1.Cells(1, 23).Resize(UBound(sp)) = Application.Index(sp, , 6)
End Sub

Bekijk bijlage SommenAlsSumIfsAantallenAlsCountIfsGemiddeldenAlsAverageIfsExcelbat.xlsb

Greetz/Excelbat

 

[edmoor]

Het werkt hier prima, in enkele seconden.

 

[snb]

Op welke regel ontstaat het probleem ?

 

[Excelbat]

@Edmoor: ja t/m 2000 regels werkt het prima. Maar als je de range verandert naar bijv. A1:H2500, dan niet meer.
@SNB: valt meestal hier ergens stil:

sp(j, 1) = sn(j, 1)
sp(j, 2) = sn(j, 2)
sp(j, 3) = sn(j, 4)

Thanx/Excelbat

 

[snb]

Het lijkt me voor de hand liggender hier met een dictionary te werken.

Maar deze aanpak is wellicht ook bruikbaar:
Geeft hier met jouw 10.000 items een snel resultaat

Sub M_Excelbat()
   sn = Range("a1:h2000")
   sp = sn
  
    For j = 2 To UBound(sn)
        sp(j, 4) = 0
        sp(j, 5) = 0
        For jj = 2 To UBound(sn)
           If sn(jj, 1) = sn(j, 1) Then
              If sn(jj, 2) = sn(j, 2) Then sp(j, 4) = sp(j, 4) + sn(jj, 4)
              If sn(j, 2) = sn(j, 2) Then sp(j, 5) = sp(j, 5) + 1
           End If
        Next
        sp(j, 6) = sp(j, 4) / sp(j, 5)
    Next
    
    Tabelle1.Cells(1, 13).Resize(UBound(sp), 6) = sp
End Sub

 

[Excelbat]

Thanx SNB,

Ik ga deze week op mijn gemak uitpluizen wat het verschil is tussen mijn code en uw code.
En waarom mijn code dus blijkbaar meer van het geheugen vergt dan uw code.
Ik kom hierop terug.

Thanx/Excelbat

 

[Excelbat]

Als ik in mijn macro dit wijzig:

ReDim sp(2000, 7)

wijzigen in dit

sp = sn

Dan loopt mijn macro ook zonder problemen door.

a) Eerste vraag: heeft iemand enig idee hoe dit komt? In beide macro's nemen sp(2000, 7) en sn toch even veel ruimte in?
b) Tweede vraag: waarom is de code van SNB behoorlijk wat sneller? Volgens mij doen beide codes het zelfde aantal loops.

Greetz/Excelbat

 

[VenA]

a) nee. sp heeft een 'bereik' van 0 t/m 2000 rijen en van 0 t/m 7 kolommen.

Sub VenA()
  sn = Range("a1:h2000")
  ReDim sp(2000, 7)
  ReDim ar(1 To 2000, 1 To 8)
  MsgBox UBound(sn) * UBound(sn, 2) & Chr(10) & (UBound(sp) + 1) * (UBound(sp, 2) + 1) & Chr(10) & UBound(ar) * UBound(ar, 2)
End Sub

Op de site van snb is van alles te vinden over de onder- en bovengrenzen van array's.

b) weet ik niet. Mij lijken de testcondities anders.