AW: Makro sehr langsam, Speicher leeren möglich?
04.03.2009 15:39:27
uli
Hallo Franz und Renée,
eure Tipps haben leider keinen bemerkbaren Geschwindigleitsvorteil nach Schleifedurchlauf 1X.XXX gebracht.
Hier mal das Problem:
Sub test()
Dim erlösm(1 To 12)
Dim schleifekd As Long
Dim anzahlkd As Long
Abplication.ScreenUpdating = False
anzahlkd = Abplication.WorksheetFunction.CountA(Sheets(1).Columns(1))
For schleifekd = 2 To anzahlkd
vj = Sheets(1).Cells(schleifekd, 18).Value
Lst = Sheets(1).Cells(schleifekd, 16).Value
For Monat = 1 To 12
tmon = Sheets(1).Cells(schleifekd, 22 + Monat).Text
vm = Sheets(1).Cells(schleifekd, 36 + Monat).Value
If tmon = "" Then
For schleife = Monat - 1 To 1 Step -1
tmon = Sheets(1).Cells(schleifekd, 22 + schleife).Text
If tmon "" Then Exit For
Next schleife
End If
ab = 0
gb = 0
sp = 0
grenze = 0
a = 0
G = 0
Spe = 0
erlös = 0
Select Case tmon
Case "hallo1 ", "hallo2GSV510 "
ab = Sheets(6).Cells(4, Monat + 1).Value
gb = 0
sp = Sheets(6).Cells(4, 50).Value
Case "hallo3 ", "hallo4 ", "hallo5 "
ab = Sheets(6).Cells(6, Monat + 1).Value
gb = 0
sp = Sheets(6).Cells(6, 50).Value
Case "hallo6 ", "hallo7 ", "hallo8 ", "hallo9 "
ab = Sheets(6).Cells(9, Monat + 1).Value
gb = 0
sp = Sheets(6).Cells(9, 50).Value
Case "hallo11"
ab = Sheets(6).Cells(13, Monat + 1).Value
gb = 0
sp = Sheets(6).Cells(13, 50).Value
Case "hallo12 ", "hallo13 "
ab = Sheets(6).Cells(14, Monat + 1).Value
gb = 0
sp = Sheets(6).Cells(14, 50).Value
Case "hallo14 "
ab = Sheets(6).Cells(16, Monat + 1).Value
gb = 0
sp = 0
Case "hallo15 ", "hallo16", "hallo17", "hallo18", "hallo19"
ab = Sheets(6).Cells(17, Monat + 1).Value
gb = Sheets(6).Cells(17, Monat + 25).Value
sp = Sheets(6).Cells(17, 50).Value
grenze = 30
Case "hallo20 "
ab = Sheets(6).Cells(21, Monat + 1).Value
gb = Sheets(6).Cells(21, Monat + 25).Value
sp = 0
Case "hallo21 "
If vj 30 And grenze = 30 Then
Spe = (Lst 30) * sp
Else
Spe = sp * Lst
End If
erlös = a + G + Spe
Sheets(1).Cells(schleifekd, 48 + Monat * 3).Value = erlös
erlösm(Monat) = erlös
Next Monat
erlösesum = Abplication.WorksheetFunction.Sum(erlösm)
Sheets(1).Cells(schleifekd, 87).Value = erlösesum
Next schleifekd
Abplication.ScreenUpdating = True
End Sub