Ausführung von Code ist extrem langsam

Guten Tag zusammen
Ich habe ein Stück Code, das für die Ausführung unglaubliche 14 Sekunden braucht. Ich habe schon diverse Möglichkeiten versucht, aber es ist mir nicht gelungen, die Zeit zu optimieren.
Ich habe eine Menge von Fragebogen, die ich auswerten will. Jeder Fragebogen besteht aus 10 Abschnitten mit je einem Titel. Ich hole in einem ersten Teil die Werte aus den einzelnen Fragenbogen und fülle sie ab:
- AnzahlFragebogenKapX enthält die Menge der Fragenbogen, bei denen das Kapitel X (mit X =1..10) ausgefüllt wurde
- GesamtwertKapX enthält den Gesamtwert des entsprechenden Kapitels
- (Schlussendlich will ich den Durchschnittswert aller Fragebogen ausgeben).

Hier der Code:

   If AnzahlFragebogenKap1 = 0 Then
        Range("AA4").Value = "" ' kein einziger Fragebogen ist ausgefüllt oder "Nicht feststellbar" wurde gewählt!
    Else
        Range("AA4").Value = GesamtwertKap1 / AnzahlFragebogenKap1 ' Gesamtwert durch die Anzahl gültiger Fragebögen dividieren
    End If
    
    If AnzahlFragebogenKap2 = 0 Then
        Range("AA5").Value = "" ' kein einziger Fragebogen ist ausgefüllt oder "Nicht feststellbar" wurde gewählt!
    Else
        Range("AA5").Value = GesamtwertKap2 / AnzahlFragebogenKap2 ' Gesamtwert durch die Anzahl gültiger Fragebögen dividieren
    End If
    
    If AnzahlFragebogenKap3 = 0 Then
        Range("AA6").Value = "" ' kein einziger Fragebogen ist ausgefüllt oder "Nicht feststellbar" wurde gewählt!
    Else
        Range("AA6").Value = GesamtwertKap3 / AnzahlFragebogenKap3 ' Gesamtwert durch die Anzahl gültiger Fragebögen dividieren
    End If
    
    If AnzahlFragebogenKap4 = 0 Then
        Range("AA7").Value = "" ' kein einziger Fragebogen ist ausgefüllt oder "Nicht feststellbar" wurde gewählt!
    Else
        Range("AA7").Value = GesamtwertKap4 / AnzahlFragebogenKap4 ' Gesamtwert durch die Anzahl gültiger Fragebögen dividieren
    End If
    
    If AnzahlFragebogenKap5 = 0 Then
        Range("AA8").Value = "" ' kein einziger Fragebogen ist ausgefüllt oder "Nicht feststellbar" wurde gewählt!
    Else
        Range("AA8").Value = GesamtwertKap5 / AnzahlFragebogenKap5 ' Gesamtwert durch die Anzahl gültiger Fragebögen dividieren
    End If
    
    If AnzahlFragebogenKap6 = 0 Then
        Range("AA9").Value = "" ' kein einziger Fragebogen ist ausgefüllt oder "Nicht feststellbar" wurde gewählt!
    Else
        Range("AA9").Value = GesamtwertKap6 / AnzahlFragebogenKap6 ' Gesamtwert durch die Anzahl gültiger Fragebögen dividieren
    End If
    
    If AnzahlFragebogenKap7 = 0 Then
        Range("AA10").Value = "" ' kein einziger Fragebogen ist ausgefüllt oder "Nicht feststellbar" wurde gewählt!
    Else
        Range("AA10").Value = GesamtwertKap7 / AnzahlFragebogenKap7 ' Gesamtwert durch die Anzahl gültiger Fragebögen dividieren
    End If
    
    If AnzahlFragebogenKap8 = 0 Then
        Range("AA11").Value = "" ' kein einziger Fragebogen ist ausgefüllt oder "Nicht feststellbar" wurde gewählt!
    Else
        Range("AA11").Value = GesamtwertKap8 / AnzahlFragebogenKap8 ' Gesamtwert durch die Anzahl gültiger Fragebögen dividieren
    End If
    
    If AnzahlFragebogenKap9 = 0 Then
        Range("AA12").Value = "" ' kein einziger Fragebogen ist ausgefüllt oder "Nicht feststellbar" wurde gewählt!
    Else
        Range("AA12").Value = GesamtwertKap9 / AnzahlFragebogenKap9 ' Gesamtwert durch die Anzahl gültiger Fragebögen dividieren
    End If
    
    If AnzahlFragebogenKap10 = 0 Then
        Range("AA13").Value = "" ' kein einziger Fragebogen ist ausgefüllt oder "Nicht feststellbar" wurde gewählt!
    Else
        Range("AA13").Value = GesamtwertKap10 / AnzahlFragebogenKap10 ' Gesamtwert durch die Anzahl gültiger Fragebögen dividieren
    End If

Kurz gesagt: Ich fülle einfach 10 Zellen von AA4 bis AA13 mit einem Wert ab. Und das dauert 14 Sekunden!

Was ich schon versucht habe:
- Zuerst alle Werte in Zwischenwerte ausrechnen und dann die Zwischenwerte in AA4 bis AA13 schreiben. Die Berechnung ist blitzschnell, das Schreiben auf die Zellen dauert 14 Sekunden.
- Anstelle von "Range" mit "Cells" arbeiten; also Cells(4,27) = anstelle von Range ("AA4").Value. Das dauert ebenfalls lange 14 Sekunden.

Hat jemand aus der Community einen Tipp, wie ich 10 Werte schneller in 10 Zellen abfüllen kann? Ich bin für jede Idee dankbar.

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sali Rudi

danke für Deine blitzschnelle Antwort!

ja, ich verwende:

Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)

den schalte ich aber mit

    Application.EnableEvents = False ' Keine Ereignisse auslösen. Das dauert sonst länger

vorgängig aus.

Dann habe ich noch einen Versuch gemacht: Ich habe den Teil des Codes, den ich beschrieben habe, in eine eigene Test-Datei abgefüllt. Dann geht es blitzschnell. also liegt also nicht am Code, sondern an Dingen, sonst noch laufen (oder Ressourcen brauchen ohne Ende). Wenn ich meine Originaldatei wieder lade, dauert die Ausführung des gleichen Test-Codes in der zweiten Datei wieder 14 Sekunden!

Etwas zum Hintergrund das ich sagen darf:
- Ich habe eine Firma mit 78 Filialen
- Pro Filiale füllen 1 bis 30 Mitarbeitende je einen Fragebogen ab
- Die Datei hat also aktuell rund 1500 Arbeitsblätter
- und sie ist etw 4Mb gross

Herzliche Grüsse Schneemann58

Sub M_snb() ' Statt GesamtwertKap: G_ ' Statt AnzahlFragebogenKap A_ ' Statt AnzahlFragebogenKap: F_ sn = Range("AA4:AA13") sp = Array(G_1 / A_1, G_2 / A_2, G_3 / A_3, G_4 / A_4, G_5 / A_5, G_6 / A_6, G_7 / A_7, G_8 / A_8, G_9 / A_9, G_10 / A_10) sq = aray(F_1, F_2, F_3, F_4, F_5, F_6, F_7, F_8, F_9, F_10) For j = 1 To UBound(sn) sn(j, 1) = IIf(sq(j - 1) = 0, "", sp(j - 1)) Next Range("AA4:AA13") = sn End Sub

Beliebteste Forumthreads (12 Monate)

Ausführung von Code ist extrem langsam

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread