Code sehr langsam trotz starkem PC

Forumthread: Code sehr langsam trotz starkem PC

13.09.2024 16:22:14

AlSp

Hallo!

Ich habe ein kleines Problem mit einem Code, den ich geschrieben habe. Er soll in verschiedenen Arbeitsblättern nach bestimmten Zeichenfolgen suchen (die sich aus Kürzeln und einem Zusatz (A, B, C und D sind nur Platzhalter der Übersichtbarkeit wegen) ergeben) und die Anzahl der betroffenen Zellen addieren.

Das funktioniert auch wunderbar, allerdings ist der Code sehr langsam (etwa 10 Sekunden, trotz ganz neuer CPU). In der Datei gibt es etwa 50 Blätter, die durchsucht werden müssen.

Ist das so zu erwarten oder ist der Code "schlecht" (oder beides)?

Danke für eure Hilfe.

Viele Grüße
Alexander



Sub Statistik()



    Dim ws As Worksheet

    Dim cell As Range

    Dim countKr As Long

    Dim countKi As Long

    Dim countFobi As Long

    Dim countQuali As Long

    Dim searchRange As Range

    Dim statistikSheet As Worksheet

    Dim searchText As String

    Dim i As Long

    

    On Error Resume Next

    Set statistikSheet = ThisWorkbook.Worksheets("Statistiken")

    On Error GoTo 0

    

    If statistikSheet Is Nothing Then

        MsgBox "Das Arbeitsblatt 'Statistiken' existiert nicht.", vbExclamation

        Exit Sub

    End If

    

    For i = 3 To 74

        searchText = statistikSheet.Cells(i, 2).Value 



        countA = 0

        countB = 0

        countC = 0

        countD = 0

        



        For Each ws In ThisWorkbook.Worksheets

            If Left(ws.Name, 2) = "KW" Then

                ' Setze den zu durchsuchenden Bereich

                On Error Resume Next

                Set searchRange = ws.Range("A25:E40")

                On Error GoTo 0

                



                If Not searchRange Is Nothing Then

                    For Each cell In searchRange

                        ' Zählen der Vorkommen von ": A"

                        If InStr(cell.Value, searchText & ": A") > 0 Then

                            countKr = countA + 1

                        End If



                        If InStr(cell.Value, searchText & ": B") > 0 Then

                            countKi = countB + 1

                        End If



                        If InStr(cell.Value, searchText & ": C") > 0 Then

                            countFobi = countC + 1

                        End If



                        If InStr(cell.Value, searchText & ": D") > 0 Then

                            countQuali = countD + 1

                        End If

                    Next cell

                End If

                



                Set searchRange = Nothing

            End If

        Next ws

        



        statistikSheet.Cells(i, 3).Value = countA   ' Ergebnis für ": A"

        statistikSheet.Cells(i, 4).Value = countB   ' Ergebnis für ": B"

        statistikSheet.Cells(i, 5).Value = countC ' Ergebnis für ": C"

        statistikSheet.Cells(i, 6).Value = countD ' Ergebnis für ": Di"

    Next i



    ' Informiere den Benutzer über den Abschluss

    MsgBox "Die Statistik wurde aktualisiert.", vbInformation



End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Code sehr langsam trotz starkem PC

13.09.2024 17:01:06

daniel

Hi

mal zuerst: bist ganz sicher, dass der Code funktioniert????
ich meine, du zählst die Vorkommen von A mit: countKr = countA + 1
und verwendest hinterher das countKr nicht mehr, und auch das countA bleibt so ja immer auf dem selben Wert.
müsste das nicht sein: countA = countA + 1?

aber wenn du sagst der Code funktionert, dann wird das auch so sein.

jetzt zu deinem Geschwindigkeitsproblem:

du läufst hier über viele viele Zellen und das ist langsam.
das ist, wie wenn du in einem Schulgebäude von Klassenzimmer zu Klassenzimmer rennst, um zu schauen was auf der jeweiligen Tafel steht.

es gibt aber eine Methode, die schneller ist. Man schaut vom Schulhof mit dem Fernglas durchs Fenster, schreibt sich auf einen Zettel, was man durchs Fenster auf der Tafel gelesen hat und dann arbeitet man mit diesem Zettel.
In Excel nennt sich dieser "Zettel" dann Array (zweidimensionales Array).

dazu musst du deinen Code so abändern (ich schreibe nur die Änderungen auf:

1. in der Dimensionierung die Werte- und Laufvariable als Variant deklarieren

Dim cell As Variant

Dim searchRange As Variant

2. die Zellwerte auf einen "Zettel" schreiben, durch das weglassen des SET bekommst du keine Objektvariable, sondern nur die Werte (also deinen Zettel)

searchRange = ws.Range("A25:E40").value

3. und in der Folge dann immer nur cell anstelle von cell.Value, weil du jetzt hier nur eine normale Wertvariable hast und kein Objekt mit vielen Eigenschaften:

If InStr(cell, searchText & ": A") > 0 Then

   countKr = countA + 1

End If

das sollte dann schneller sein.

Gruß Daniel

AW: Code sehr langsam trotz starkem PC

13.09.2024 17:05:44

snb

Lade mal bitte eine Beispieldatei hoch.
Suchen in Arbeitsblättern ist immer langsam.
Verwende Arrays.

AW: Code sehr langsam trotz starkem PC

13.09.2024 17:09:01

ralf_b

nur mal so zum ausprobieren. ungetestet!!

Sub Statistik()



    Dim ws As Worksheet

    Dim statistikSheet As Worksheet

    Dim searchText As String

    Dim i As Long

    

    On Error Resume Next

    Set statistikSheet = ThisWorkbook.Worksheets("Statistiken")

    If Err > 0 Then

        MsgBox "Das Arbeitsblatt 'Statistiken' existiert nicht.", vbExclamation

        Err.Clear

        Exit Sub

    End If

    

    Dim arr: arr = statistikSheet.Cells(3, 2).Resize(71, 1).Value

    Dim arrErg: ReDim arrErg(1 To 71, 1 To 4)

    Dim arrrng, arritem

    

    For i = LBound(arr) To UBound(arr)

        searchText = arr(i, 1)



        For Each ws In ThisWorkbook.Worksheets

            If Left(ws.Name, 2) = "KW" Then

                ' Setze den zu durchsuchenden Bereich

                On Error Resume Next

                arrrng = ws.Range("A25:E40").SpecialCells(xlCellTypeConstants)

                If Err = 0 Then

                       For Each arritem In arrrng

                            arrErg(i, 1) = arrErg(i, 1) + (InStr(arritem, searchText & ": A") > 0) * 1

                            arrErg(i, 2) = arrErg(i, 2) + (InStr(arritem, searchText & ": B") > 0) * 1

                            arrErg(i, 3) = arrErg(i, 3) + (InStr(arritem, searchText & ": C") > 0) * 1

                            arrErg(i, 4) = arrErg(i, 4) + (InStr(arritem, searchText & ": D") > 0) * 1

                       Next arritem 'cell

                 Else

                    Err.Clear

                 End If

            End If

        Next ws

        

    Next i

   statistikSheet.Cells(3, 3).Resize(1, 4) = arrErg

    ' Informiere den Benutzer über den Abschluss

    MsgBox "Die Statistik wurde aktualisiert.", vbInformation



End Sub

AW: Code sehr langsam trotz starkem PC

13.09.2024 18:16:42

Onur

Verstehe diese Zeilen nicht:

                On Error Resume Next

                Set searchRange = ws.Range("A25:E40")

                On Error GoTo 0

                



                If Not searchRange Is Nothing Then

1) Wozu das "On Error" ? Was genau kann da schiefgehen ? Du gibts doch nur einen Bereich in eine Variable..
2) Wann und wie genau sollte denn searchRange NOTHING werden können ?
3) countQuali = countD + 1 ?
Was soll das bringen? Dann ändert sich ja countD nie - und damit auch nicht countQuali.
Du suchst 72 Texte in 80 Zellen in sämtlichen KW-Blättern - sagen wir mal 52 - das sind so 300.000 Suchvorgänge. Kein Wunder, dass der Code so lange braucht.

AW: Code sehr langsam trotz starkem PC

13.09.2024 19:25:28

daniel

Vielleicht lässt sich das ganze ohne Code auch lösen.

im Freien Bereich des Blattes Statistiken sammelst du die Daten der Tabellenblätter.
in der Spalte Z schreibst du ab Zeile 1 mit 16 Zeilen abstand (Zeile 1, 17, 33, 49 usw) immer die Namen der Tabellenblätter, die du auswerten willst
in die Spalte AA schreist du dann daneben jeweils die Formel =Wennfehler(Indirekt("'"&Z1&"'!A25:E40");"--- keine Daten ---")

damit hast du dann die Daten aller Blätter in den Spalten AA:AE

in die Zellen C2-F2 schreibst du dann die Buchstaben A, B, C, D (also die, die du für deine Auswertung brauchst

und in die Zellen C3 kommt dann diese Formel:
=ZÄHLENWENNS(AA:AE;"*"&B3:B7&": "&C2:F2&"*")

Code brauchst du dann eigentlich nicht, außer du willst dir die Zellinhalte aus den Tabellenblättern nicht per Formel sondern per Makro holen.

das würde ich dann so machen:

Sub test()

Dim ws As Worksheet

Dim z As Long

z = 1

Application.Calculation = xlCalculationManual

With Worksheets("Statistiken")

    .Range("Z:AE").ClearContents

    For Each ws In ThisWorkbook.Worksheets

         If ws.Name Like "KW*" Then

             .Cells(z, 26).Value = ws.Name

             .Cells(z, 27).Formula2 = "='" & ws.Name & "'!A25:E40"

             z = z + 16

        End If

    Next

End With

Application.Calculation = xlCalculationAutomatic

End Sub

das ganze dauert bei mir mit den von dir genannten Datenmengen (c.a. 50 Blätter mit je 80 Werten = 4000 Werte, kombiniert mit 74*4 = c.a 300 Auswertungen) keine halbe Sekunde.

Gruß Daniel

Beliebteste Forumthreads (12 Monate)

Code sehr langsam trotz starkem PC

Forumthread: Code sehr langsam trotz starkem PC

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread