VBA Excel: Loop wie stoppen ?

Computer: Software & Programmierung Visual Basic
#1

Hallo Experten,

ich habe hier eine Excel Liste

SpalteA SpalteB SpalteC SpalteD

  1. 017000 L11014 202100 74,00
  2. 017000 L11014 221000 120,00
  3. 017000 L11015 221000 26,00
  4. 017000 L11015 221100 1320,00
  5. 017000 L11015 221100 96,00
  6. 017000 L11015 221100 70,00
  7. 017000 L11015 221400 400,00

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 ?

Sub test()
Dim i As Long

Do While i

#2

Hallo,

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.

Sub test()
Dim i As Long

Do While i

#3

Hi Marsi,

ich muß noch mal nachfragen … :smile: Warum das i = i + 1 ???

Do While i

#4

Danke für eure Hilfe. Ich wollte jetzt einen Zähler einbauen, der 10 mal durchrechnet und dann stoppt.

Hier läuft er aber leider auch wieder in eine Endlosschleife :frowning:((

Hilflosen Gruß, Marsi

Sub test()
Dim i As Long

Do While i

#5

Hallo,

Du hast wieder das selbe Problem.

Du schreibst …

i = i # 1
i = i - 1

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
#6

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 :smile:
Gruß
Reinhard

#7

Hallo Rainer.

i = i # 1
i = i - 1

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.

Viele Grüße
Carsten

#8

Hallo Marsi.
Ich habe Deinen Code mal auf zwei Arten ausprobiert:

  1. Normal, dann hängt er sich auch bei mir auf.
  2. 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

Viele Grüße
Carsten

#9

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:

Tabellenblattname: Tabelle1
 A B C D 
1 017000 L11014 202100 74 
2 017000 L11014 221000 120 
3 017000 L11015 221000 26 
4 017000 L11015 221100 1320 
5 017000 L11015 221100 96 
6 017000 L11015 221100 70 
7 017000 L11015 221400 400

Probiers mal so:

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

Gruß
Reinhard

#10

Danke an alle. Jetzt hat es geklappt :smile:
.