Ich habe mehrere Varianten probiert, aber die Schleifen brauchen bei meinen Varianten immer über eine Minute.
Application.ScreenUpdating = False
Application.ScreenUpdating = True
Habe ich auch integriert.
Okay, die Aufgabe der Schleife ist nicht ohne, m=Montage hat 17 verschiedene Kostenstellen, und f= fertigung hat fünf verschiedene Kostenstellen. All diese Kostenstellen sind in der Spalte H37:H649. Die Kostenstellen sind in der Spalte vermischt. Es gibt keine Ordnung. Die Schleife soll "k" und "K" (Krank) entsprechend der Montage und der Fertigung nach KW zählen .Die KW sind in dem Quellarbeitsblatt "Abwesenheiten" in "Z30:NZ30". Die KW von 1 bis 52 sind in "B1:BA1" in der Zieldatei. Das Ergebnis der Montage wir in "B5:BA5" dargestellt. Das Ergebnis der Fertigung findet sich in "B6:BA6".
Wie geschrieben die Schleifen funktionieren, aber jede einzelne von Ihnen knapp über eine Minute. Ich habe die Zeit gestoppt.
Kann man meine Schleifen optimieren?
Bedanke mich im Voraus für die Unterstützung.
Schleife 1
For i = 2 To 53
count = 0
For col = 26 To 390
If ws1.Cells(30, col).value = ws2.Cells(1, i).value Then
For row = 37 To 649
For Each m In montage
If UCase(ws1.Cells(row, col).value) = "K" And ws1.Cells(row, "H").value = m Then count = count + 1
Next m
Next row
End If
Next col
' Hier wird das Ergebnis in Zielarbeitsblatt geschrieben in B5:BA5
ws2.Cells(5, i).value = count
Next i
For i = 2 To 53
count = 0
For col = 26 To 390
If ws1.Cells(30, col).value = ws2.Cells(1, i).value Then
For row = 37 To 649
For Each f In fertigung
If UCase(ws1.Cells(row, col).value) = "K" And ws1.Cells(row, "H").value = f Then count = count + 1
Next f
Next row
End If
Next col
' Hier wird das Ergebnis in Zielarbeitsblatt geschrieben in B6:BA6
ws2.Cells(6, i).value = count
Next i
Schleife 2
' Konstanten für bessere Lesbarkeit
Const START_ROW As Long = 37
Const END_ROW As Long = 649
Const START_COL As Long = 26
Const END_COL As Long = 390
' Schleife für Montage
For i = 2 To 53
count = 0
For col = START_COL To END_COL
If ws1.Cells(30, col).value = ws2.Cells(1, i).value Then
For row = START_ROW To END_ROW
Dim m As Variant
For Each m In montage
If UCase(ws1.Cells(row, col).value) = "K" And ws1.Cells(row, "H").value = m Then count = count + 1
Next m
Next row
End If
Next col
' Ergebnis in Zielarbeitsblatt schreiben
ws2.Cells(5, i).value = count
Next i
' Schleife für Fertigung
For i = 2 To 53
count = 0
For col = START_COL To END_COL
If ws1.Cells(30, col).value = ws2.Cells(1, i).value Then
For row = START_ROW To END_ROW
Dim f As Variant
For Each f In fertigung
If UCase(ws1.Cells(row, col).value) = "K" And ws1.Cells(row, "H").value = f Then count = count + 1
Next f
Next row
End If
Next col
' Hier wird das Ergebnis in Zielarbeitsblatt geschrieben
ws2.Cells(6, i).value = count
Next i
Schleife 3
Dim data As Variant
data = ws1.Range(ws1.Cells(30, 26), ws1.Cells(649, 390)).value
For i = 2 To 53
count = 0
For col = 26 To 390
If data(1, col) = ws2.Cells(1, i).value Then
For row = 37 To 649
For Each m In montage
If UCase(data(row, col)) = "K" And data(row, "H") = m Then count = count + 1
Next m
Next row
End If
Next col
' Hier wird das Ergebnis in Zielarbeitsblatt geschrieben
ws2.Cells(5, i).value = count
Next i
For i = 2 To 53
count = 0
For col = 26 To 390
If data(1, col) = ws2.Cells(1, i).value Then
For row = 37 To 649
For Each f In montage
If UCase(data(row, col)) = "K" And data(row, "H") = f Then count = count + 1
Next f
Next row
End If
Next col
'
' Hier wird das Ergebnis in Zielarbeitsblatt geschrieben
ws2.Cells(6, i).value = count
Next i