Schleife funktioniert nicht
05.11.2019 14:38:08
Hubert
nachstehend vorweg der Code meines Makros:
Sub Umformat()
Dim zeile As Integer
Dim spalte As Integer
Dim feldinhalt As String
Dim anz_mahlzeiten As Integer
Dim zeile_tab1 As Integer
Dim spalte_tab1 As Integer
Dim zeile_tab2 As Integer
Dim spalte_tab2 As Integer
Dim end_zeile As Integer
zeile_tab1 = 1
spalte_tab1 = 1
zeile_tab2 = 1
Sheets("Tabelle2").Cells(1, 1) = "Datum"
Sheets("Tabelle2").Cells(1, 2) = "Kostenstelle"
Sheets("Tabelle2").Cells(1, 3) = "Station"
Sheets("Tabelle2").Cells(1, 4) = "Frühstück"
Sheets("Tabelle2").Cells(1, 5) = "Mittagessen"
Sheets("Tabelle2").Cells(1, 6) = "Abendessen"
Sheets("Tabelle2").Cells(1, 7) = "Summe Essen"
Do While IsEmpty(Sheets("Tabelle1").Cells(zeile_tab1, 1)) = False
If IsEmpty(Sheets("Tabelle1").Cells(zeile_tab1, 1)) = True Then Exit Do
zeile_tab2 = zeile_tab2 + 1
Do
zeile_tab1 = zeile_tab1 + 1
If Mid(Sheets("Tabelle1").Cells(zeile_tab1, spalte_tab1).Value, 8, 1) = "s" Then
feldinhalt = Sheets("Tabelle1").Cells(zeile_tab1, spalte_tab1).Value
Sheets("Tabelle2").Cells(zeile_tab2, 2) = feldinhalt
ElseIf Mid(Sheets("Tabelle1").Cells(zeile_tab1, spalte_tab1).Value, 8, 1) = ":" Then
feldinhalt = Sheets("Tabelle1").Cells(zeile_tab1, spalte_tab1).Value
Sheets("Tabelle2").Cells(zeile_tab2, 3) = feldinhalt
ElseIf Mid(Sheets("Tabelle1").Cells(zeile_tab1, spalte_tab1).Value, 11, 1) = "F" Then
feldinhalt = Sheets("Tabelle1").Cells(zeile_tab1, spalte_tab1).Value
anz_mahlzeiten = Sheets("Tabelle1").Cells(zeile_tab1, spalte_tab1 + 1).Value
Sheets("Tabelle2").Cells(zeile_tab2, 4) = anz_mahlzeiten
ElseIf Mid(Sheets("Tabelle1").Cells(zeile_tab1, spalte_tab1).Value, 11, 1) = "M" Then
feldinhalt = Sheets("Tabelle1").Cells(zeile_tab1, spalte_tab1).Value
anz_mahlzeiten = Sheets("Tabelle1").Cells(zeile_tab1, spalte_tab1 + 1).Value
Sheets("Tabelle2").Cells(zeile_tab2, 5) = anz_mahlzeiten
If Sheets("Tabelle1").Cells(zeile_tab1 + 1, spalte_tab1).Value "Mahlzeit: _
Abend" Then
Exit Do
End If
ElseIf Mid(Sheets("Tabelle1").Cells(zeile_tab1, spalte_tab1).Value, 11, 1) = "A" Then
feldinhalt = Sheets("Tabelle1").Cells(zeile_tab1, spalte_tab1).Value
anz_mahlzeiten = Sheets("Tabelle1").Cells(zeile_tab1, spalte_tab1 + 1).Value
Sheets("Tabelle2").Cells(zeile_tab2, 6) = anz_mahlzeiten
Exit Do
ElseIf Mid(Sheets("Tabelle1").Cells(zeile_tab1, spalte_tab1).Value, 4, 1) = ":" Then
feldinhalt = Sheets("Tabelle1").Cells(zeile_tab1, spalte_tab1).Value
Sheets("Tabelle2").Cells(zeile_tab2, 1) = feldinhalt
anz_mahlzeiten = Sheets("Tabelle1").Cells(zeile_tab1, spalte_tab1 + 1).Value
Sheets("Tabelle2").Cells(zeile_tab2, 7) = anz_mahlzeiten
ElseIf Mid(Sheets("Tabelle1").Cells(zeile_tab1, spalte_tab1).Value, 2, 1) = "o" Then
End If
i = i + 1
Loop
Loop
End Sub
zur Erläuterung:
ich habe eine Tabelle1 aus der ich zeilenweise Feldinhalte kopiere und sie in Tabelle2 in einer anderen (besser auswertbaren) Struktur einfüge. Das funktioniert soweit einwandfrei.
Das Problem:
Dummerweise findet die äußere
Do While IsEmpty(Sheets("Tabelle1").Cells(zeile_tab1, 1)) = False
Schleife kein Ende, obwohl in Tabelle1 eindeutig ein leeres Feld, welches die Schleife beendet kommt. An dieser Stelle habe ich alle möglichen Schleifen versucht (u.a. auch For Next mit festen Zahlenwerten (von i=1 bis 13000)). Die äußere Do While Schleife läuft immer bis das zeile_tab1 = 32.767 (also Maxwert für Integer) ist (egal wie ich die Schleife ausführe oder Exit bei entsprechenden If-Abfragen einfüge).
Normalerweise müsste bei end_zeile = 12.301 (das ist das erste leere Feld in der Tabelle) die äußere Do Schleife aussteigen. Mit dem folgenden Code wird end_zeile auch korrekt hochgezählt und die Schleife wird ordnungsgemäß verlassen:
Do While IsEmpty(Sheets("Tabelle1").Cells(zeile_tab1, 1)) = False
zeile_tab1 = zeile_tab1 + 1
end_zeile = zeile_tab1
Loop
Warum funktioniert das nur bei der o.a. Do While Schleife nicht. Der einzige Unterschied zwischen den beiden Schleifen ist auch meiner Sicht derjenige, dass im ersten Fall etwas mehr Quellcode zwischen Do While und Loop steht; aber das kann doch kein Hinderungsgrund für das korrekte Verlassen der Schleife sein. Sitze nun seit mehreren Stunden an dem Problem und bin mittlerweile recht verzweifelt; wäre super, wenn jemand helfen könnte; vorab ganz herzlichen Dank!!!
viele Grüße
Hubert
Anzeige