AW: Tut sich nix....
06.06.2005 14:02:45
IngGi
Hallo Daniel,
der Exit Sub-Befehl war in der falschen Bedingung der If-Prüfung. Das hab ich korrigiert und ein paar Kommentare eingefügt. Ich hoffe, das ist einigermaßen verständlich. Der Ablauf ist nämlich ziemlich komplex. Daher hier auch noch eine kurze Beschreibung:
Das Makro nimmt sich die erste Zelle in Spalte A von Blatt PT, also A2
In Spalte A des Blattes Open Trades wird jetzt nach einem identischen Eintrag gesucht
Wenn gefunden, wird in der gleichen Zeile (also Zeile 2 in PT und Zeile der vorher gefundenen Zelle in Open Trades) die Spalte G/J verglichen.
Jetzt muß noch auf Doppelfälle geprüft werden. Dazu wird der Inhalt der Spalte G in PT gesucht, und zwar in allen Zellen der Spalte J in Open Trades, von der aktuellen Zelle (= Zelle, die vorher in Spalte A gefunden wurde), bis zur letzten beschriebenen Zelle.
Dabei werden allerdings alle Zellen gefunden, die beim Vergleich der Spalten G/J identisch sind, unabhängig davon, ob sie auch beim Vergleich der Spalte A identisch sind. Derher muß die Spalte A bei der gefundenen Zeile auch noch mal geprüft werden.
Wenn kein Doppelfall gefunden wird, wird in einer Endlosschleife (Do...Loop) weitergesucht (auch hier wieder zuerst Vergleich der Spalten G/J und anschließend nochmal der Vergleich der Spalte A). Die Endlosschleife wird über den Befehl Exit Do verlassen, sobald ein Doppelfall gefunden und der Merker auf True gesetzt wurde oder der Vergleich der Spalten G/J zu keinem Ergebnis mehr führt (rngOT2=Nothing).
Wenn auch in der Endlosschleife kein Doppelfall gefunden wird, wird die Spalte E übertragen und das Makro macht mit der nächsten Zelle in Spalte A, Blatt PT weiter.
Sub finden_kopieren()
Dim rngPT As Range 'Verweist auf die Zelle in TB "PT", Spalte A, die gerade bearbeitet wird
Dim rngOT1 As Range 'Verweist auf die gefundene Zelle in TB "Open Trades", Spalte A
Dim rngOT2 As Range 'Verweist auf die gefundene Zelle in TB "Open Trades", Spatle J
Dim Doppelt As Boolean 'Merker für Doppelfälle
'Bearbeite im Blatt PT alle Zellen von A2 bis A? (letzte beschriebene Zelle in Spalte A)
For Each rngPT In Sheets("PT").Range("A2:A" & Range("A65536").End(xlUp).Row)
'Suche Zelle in Open Trades, Spalte A, mit gleichem Inhalt, wie aktuell bearbeitete Zelle in PT
Set rngOT1 = Sheets("Open Trades").Range("A:A").Find(what:=rngPT, lookat:=xlWhole)
'Wenn Zelle mit gleichem Inhalt gefunden ...
If Not rngOT1 Is Nothing Then
'Wenn der Inhalt der Zelle 6 Spalten rechts von rngPT (=Blatt PT, Spalte G)
'gleich dem Inhalt der Zelle 9 Spalten rechts von rngOT1 (=Blatt Open Trades, Spalte J, dann...
If rngPT.Offset(0, 6) = rngOT1.Offset(0, 9) Then
'Suche nach doppelter Zelle in Open Trades, Spalte J, Zeile der vorher gefundenen Zelle
'in Spalte A bis letzte beschriebene Zelle in Spalte J.
Set rngOT2 = Range(rngOT1.Offset(1, 9), rngOT1.Offset(0, 6).End(xlDown)) _
.Find(what:=rngPT.Offset(0, 6), lookat:=xlWhole)
'Wenn doppelte Zelle gefunden...
If Not rngOT2 Is Nothing Then
'Prüfen, ob Eintrag in Spalte A ebenfalls identisch und wenn ja, Merker auf True
If rngOT2.Offset(0, -9) = rngPT Then Doppelt = True
End If
'Wenn doppelte Zelle nicht gefunden ...
If Doppelt = False Then
Do '... weitersuchen nach doppelter Zelle
Set rngOT2 = Range(rngOT1.Offset(1, 0), rngOT1.End(xlDown)).FindNext
'Wenn beim Weitersuchen doppelte Zelle nicht gefunden, raus aus Do...Loop-Schleife
If rngOT2 Is Nothing Then Exit Do
'Sonst prüfen, ob Eintrag in Spalte A ebenfalls identisch und wenn ja, Merker auf True
If rngOT2.Offset(0, -9) = rngPT.Offset(0, 6) Then Doppelt = True
Loop
End If
'Wenn doppelte Zelle gefunden...
If Doppelt = True Then
'...Nachricht ausgeben...
MsgBox ("Achtung!!! Doppelfall in Blatt 'Open Trades'.")
'...und Makro beenden.
Exit Sub
Else
'Wenn doppelte Zelle nicht gefunden, Spalte E übertragen und weiter mit nächster
'Zelle in Blatt PT, Spalte A...
rngPT.Offset(0, 4) = rngOT1.Offset(0, 9)
End If
End If
End If
Next rngPT
End Sub
Gruss Ingolf