|
Braucht man also doch zwei Schleifen. In der Beschreibung kann man das wesentlich besser erkennen, als in deiner ersten. :)
im Makro wäre rot = w; blau = q
Option Explicit
Sub Schritt10()
Dim w As Long
Dim q As Long
With Worksheets("Sheet 1")
Dim dtm As Date
dtm = Now()
For w = 2 To 502
For q = 2 To 502
If .Cells(w, "AI") = .Cells(q, "BE") _
And .Cells(w, "AN") < .Cells(q, "BJ") _
Then
.Range(.Cells(w, "AQ"), .Cells(w, "AZ")) = .Range(.Cells(q, "BC"), .Cells(q, "BL"))
.Cells(q, "CA") = 1
End If
Next
If DateDiff("s", dtm, Now()) > 2 Then 'mehr als 2 Sekunden vergangen?
dtm = Now()
DoEvents 'dem BS Zeit zum Denken geben
End If
Next
End With
Call MsgBox("Fertig.", vbInformation)
End Sub
PS: Da der Code ne Weile läuft, sollte man darüber nachdenken dessen Status in der Statusleiste anzuzeigen.
|