Wenn Spalte B und C identisch sind, dann sollen die Zahlen in Spalte D
addiert werden. Hier wird also Reihe 4, 5 und 6 addiert. Dann müßte eine neue Zeile daraus kommen und Reihe 4,5 und 6 werden gelöscht.
Die neue Reihe müßte dann so aussehen:
017000 L11015 221100 1486
Ich habe es mit diesem Code versucht. Es klappt, aber
leider läuft es dann in einer Endlos-Schleife und hört nicht mehr auf.
Wie kann ich es abbrechen lassen ohne die Task Ebene ?
von VBA habe ich keine Ahnung, aber Deine Frage betrifft ja den Teil, der mit VB identisch ist …
Ich habe es mit diesem Code versucht. Es klappt, aber
leider läuft es dann in einer Endlos-Schleife und hört nicht
mehr auf.
Wie kann ich es abbrechen lassen ohne die Task Ebene ?
Eine Do While - Schleife kannst Du mit
Exit Do
verlassen, ein Prozedur mit Exit Sub.
Das wird Dir aber nichts nützen, weil die Ursache in Deinem Code liegt.
und fragst anschließend ab, wie groß i ist. Das ist natürlich wieder so groß wie vorher. Warum machst Du das übrigens nicht mit einer Zählschleife?
Ich hätte also zwei Angebote:
Sub test()
Dim i As Long
i = ActiveSheet.UsedRange.Rows.Count - 2
Do While i
oder besser ...
Sub test()
Dim i As Long
For i = ActiveSheet.UsedRange.Rows.Count To 0 Step -1
If Cells(i, 1) = Cells(i + 1, 1) And \_
Cells(i, 2) = Cells(i + 1, 2) And \_
Cells(i, 3) = Cells(i + 1, 3) Then
Cells(i, 4) = Cells(i, 4) + Cells(i + 1, 4)
Rows(i + 1).Delete
End If
Next
End Sub
... oder wenn insgesamt nur eine Zeile gelöscht werden soll ...
Sub test()
Dim i As Long
For i = ActiveSheet.UsedRange.Rows.Count To 0 Step -1
If Cells(i, 1) = Cells(i + 1, 1) And \_
Cells(i, 2) = Cells(i + 1, 2) And \_
Cells(i, 3) = Cells(i + 1, 3) Then
Cells(i, 4) = Cells(i, 4) + Cells(i + 1, 4)
Rows(i + 1).Delete
Exit Sub
End If
Next
End Sub
Gruß, Rainer
Ich habe es mit diesem Code versucht. Es klappt, aber
leider läuft es dann in einer Endlos-Schleife und hört nicht
mehr auf.
Wie kann ich es abbrechen lassen ohne die Task Ebene ?
In dem du den Stecker des PCs ziehst *smile*
Hi Marsi,
ich habe deinen Code eben nur überflogen und mich gar nicht ins Thema vertieft.
2 Sachen
Zeilen löscht man grundsätzlich von unten nach oben, von oben nach unten geht auch, aber erfordert unnötig erhöhten Programmieraufwand.
Wieso Rainer zu dem Schluß kommt, nach i = i - 1 wäre i geichgroß entzieht sich meiner kenntnis, sehe das annerster
Gruß
Reinhard
und fragst anschließend ab, wie groß i ist. Das ist natürlich wieder so groß wie vorher.
Ja, das ist ja für seine Zwecke auch erforderlich.
Die Anweisung steht innerhalb der If-Then-Abfrage. Sie wird nur dann ausgeführt, wenn die Abfrage WAHR ist. Sie ist erforderlich , um zu überprüfen, ob die gleiche Zeile wie vorher mit derjenigen übereinstimmt, die auf die eben gelöschte folgt.
Hallo Marsi.
Ich habe Deinen Code mal auf zwei Arten ausprobiert:
Normal, dann hängt er sich auch bei mir auf.
Einzelschritt, dann funktioniert er einwandfrei.
Allerdings ist das „Aufhängen“ gar kein richtiges, denn wenn man mit der Maus irgendwo ins Tabellenblatt klickt, dann ist alle wieder paletti und Excel ist wieder bedienbar. Komische Sache.
Ich habe den Code auch ein bißchen angepasst, wodurch er die Schleife dann einmal weniger durchläuft, sofern die Daten der letzten Zeile nicht mit den Daten der vorletzen übereienstimmen. Die letzte Code Zeile bewirkt, daß die bereits markierte Zelle „nochmal“ markiert wird, damit Excel wieder funktioniert.
Private Sub test()
Dim i As Long
Do
i = i + 1
If Cells(i, 1) = Cells(i + 1, 1) And \_
Cells(i, 2) = Cells(i + 1, 2) And \_
Cells(i, 3) = Cells(i + 1, 3) Then
Cells(i, 4) = Cells(i, 4) + Cells(i + 1, 4)
Rows(i + 1).Delete
i = i - 1
End If
Loop Until i = ActiveSheet.UsedRange.Rows.Count - 1
ActiveSheet.Cells(ActiveCell.Row, ActiveCell.Column).Select
End Sub
Ich habe es mit diesem Code versucht. Es klappt, aber
leider läuft es dann in einer Endlos-Schleife und hört nicht
mehr auf.
Wie kann ich es abbrechen lassen ohne die Task Ebene ?
Hi Marsi,
ich habe deinen Code auf folgende Tabelle angewendet und erhalte keine Endlosschleife:
Sub tt()
Dim i As Long
For i = Range("A65536").End(xlUp).Row To 2 Step -1
If Cells(i, 1) = Cells(i - 1, 1) And Cells(i, 2) = Cells(i - 1, 2) And Cells(i, 3) = Cells(i - 1, 3) Then
Cells(i - 1, 4) = Cells(i - 1, 4) + Cells(i, 4)
Rows(i).Delete
End If
Next zei
End Sub