Excel VBA: Abbruch bei Schleifendurchlauf

[Kladdi]

Hallo zusammen,

dieses Problem betrifft zwar nicht direkt mich allerdings wurmt es mich ziemlich das ich den Fehler (die Syntax scheint mir fehlerfrei) nicht finden kann.

Dieser Sub soll Daten die in einem Sheet (es heißt Open Invoice) steht einfach nur darauf vergleich ob sie größer als 30 sind, ist dies der Fall soll im selben Schritt die komplette Reihe in das andere Sheet (es heißt claimed aging) übertragen werden und im Quellsheet gelöscht werden.

Leider bricht der Code (bei diesem Startwert für die Variable i) reproduzierbar bei i = 1406 (und wenn i auf den Wert 1400 gesetzt wurde bei i = 1904) ab.

Meine Frage ist lediglich ob die Syntax an dieser Stelle das Problem ist oder ob der Fehler in dem (leider recht dilettantisch geschriebenen) restlichen Code/bei der Funktion die den zu überprüfenden Wert erzeugen zu suchen ist.

Viele Grüße

Kladdi



Private Sub move_data_claimend_aging()

Set Masterfile = Application.Workbooks(ThisWorkbook.Name)   'Zuordnen der Sheets vom Masterfile
Set invoice = Masterfile.Sheets("Open invoice")
Set claimed = Masterfile.Sheets("claimed aging")

Dim j As Integer          'Zählvariable für das Sheet "claimed"
Dim i As Integer          'Zählvariable für das Sheet "invoice"

j = (claimed.Cells(Rows.Count,1).End(xlUp).Row) + 1
counter_line = invoice.Cells(Rows.Count, 1).End(xlUp).Row

i = 2

Do Until i > counter_line

    If invoice.Cells(i, 9).Value > 30 Then
    claimed.Rows(j).Value = invoice.Rows(i).Value
    invoice.Rows(i).Delete

    j = j + 1
    End If

    i = i + 1
Loop

MsgBox ("Daten Due Date >30 aus invoice tab -> in -> claimend aging tab verschoben")

End Sub

[C4RL0]

Hi,

was heißt denn, der Code bricht ab? Mit Fehlermeldung? Oder läuft der Code aufgrund der Bedingungen einfach durch und erledigt nicht das, was er eigentlich soll?

Bei mir läuft der Code übrigens bei 3000 Zeilen fehlerfrei durch, allerdings überspringt er Zeilen wenn eine Zeile gelöscht wurde.
Es wäre besser, die Kopierten Zeilen in einer Union zusammen zu fassen und diese Union zum Schluss zu löschen (bzw. im Testlauf erst mal rot zu färben und dann zu prüfen).
Das sollte den Ablauf zudem auch beschleunigen.

Beispiel zum Bilden einer Union:

Code [Auswählen] Erweitern

Set uRange = Application.Union(Range1, Range2)

[Kladdi]

Hallo Carlo,

erstmal vielen Dank für den Tipp mit der Union und die Anmerkung mit dem Überspringen.

Abbrechen war nett formuliert, ich hatte mir per Debug.print die Zeilennummern ausgeben lassen und bei den genannten Zeilen hörte das Programm schlicht auf (sichtbar) zu arbeiten und Excel reagierte nicht mehr auf Eingaben.
Es gab keine Fehlermeldungen oder ähnliches.

Viele Grüße

Kladdi

[C4RL0]

Versuch mal Dein Glück, den Code in so einem Fall mit Strg. + Pause zu unterbrechen.

Was meine o.g. Idee betrifft, so habe ich Deinen Code mal etwas modifiziert:

Code [Auswählen] Erweitern

Option Explicit

Private Sub move_data_claimend_aging()
    Dim Masterfile As Object
    Dim invoice As Object
    Dim claimed As Object
    Dim counter_line As Long
    Dim j As Long          'Zählvariable für das Sheet "claimed"
    Dim i As Long          'Zählvariable für das Sheet "invoice"
    Dim uRa As Range
    Set Masterfile = Application.Workbooks(ThisWorkbook.Name)   'Zuordnen der Sheets vom Masterfile
    Set invoice = Masterfile.Sheets("Open invoice")
    Set claimed = Masterfile.Sheets("claimed aging")
   
    j = (claimed.Cells(Rows.Count, 1).End(xlUp).Row) + 1
    counter_line = invoice.Cells(Rows.Count, 1).End(xlUp).Row
   
    i = 2
   
    Do Until i > counter_line
        If invoice.Cells(i, 9).Value > 30 Then
            invoice.Rows(i).Copy Destination:=claimed.Rows(j)
            If uRa Is Nothing Then
                Set uRa = invoice.Rows(i)
            Else
                Set uRa = Application.Union(uRa, invoice.Rows(i))
            End If
       
            j = j + 1
        End If
        i = i + 1
    Loop
   
    If Not uRa Is Nothing Then uRa.Delete
    If Not invoice Is Nothing Then Set invoice = Nothing
    If Not claimed Is Nothing Then Set claimed = Nothing
    If Not Masterfile Is Nothing Then Set Masterfile = Nothing
    MsgBox ("Daten Due Date >30 aus invoice tab -> in -> claimend aging tab verschoben")
End Sub