|
Danke, es sieht jetzt so aus bei mir.
Sub Schritt10()
Dim w As Long
Dim q As Long
With Worksheets("Sheet1")
Dim dtm As Date
dtm = Now()
For w = 2 To 502
For q = 2 To 502
If .Cells(w, "AI").Value > "" _
And .Cells(q, "BE").Value > "" _
And .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
Ich musste noch 2 If Eigenschaften hinzufügen, die Zellen wo zusammen passen sollen, müssen einen Wert haben.
Leider scheint er das If "Ja" noch nicht richtig zu erkennen, die Kopie funktoniert nicht und in Spalte "CA" bekomme ich von Zeile 2 bis 502 eine "1".
|