Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Loop ohne Do - STIMMT NICHT!

Forumthread: Loop ohne Do - STIMMT NICHT!

Loop ohne Do - STIMMT NICHT!
23.09.2003 13:03:57
KrickelD
Ich bekomme beim Starten die Meldung: Loop ohne Do...
Aber das STIMMMT NICHT! WO DENN BITTESCHÖN?
Beim Durchzählen komme ich auf die gleiche Anzahle von Do`s und Loop`s!
Könnt ihr mir helfen???

Option Explicit


Sub liste_mittel_aufteilen()
'Seitenränder mit berücksichtigen
Dim frage
frage = MsgBox("Los gehts!" & Chr(13) & Chr(13) & "Sollen die Seitenränder gleich mit verkleinert werden (dauert länger)", vbYesNo, "Discoverer-Auswertung 4.0 by KrickelD")
Dim frage2
'frage2 = MsgBox("Und soll die aktive Tabelle während des Ablaufes minimiert werden? (geht noch schneller)", vbYesNo, "Discoverer-Auswertung 4.0 by KrickelD")
frage2 = vbYes 'Nur für Test-Zwecke
If frage2 = vbYes Then
ActiveWindow.WindowState = xlMinimized
End If
'für die einzelnen Zeitberechnungen
Dim ergebnis As String, feld As Integer, anzahl As Integer, count As Integer
ergebnis = ""
feld = 0
anzahl = 0
count = 1
Dim zeit_on
Dim zeit_off
Dim zeit_diff
zeit_on = Time
Dim temp
'Vorformatierungen
Range("I5:K5").Select
Selection.Cut Destination:=Range("I6:K6")
Rows("1:5").Select
Range("A1").Activate
Selection.Delete Shift:=xlUp
Columns("L:L").Delete Shift:=xlUp
Range("A1").Select
'Ursprungstabelle wegsichern
Sheets("Budgetauswertung").Select
Sheets("Budgetauswertung").Copy After:=Sheets(1)
Sheets("Budgetauswertung (2)").Name = "Ursprungstabelle"
Sheets("Budgetauswertung").Select
Range("A1").Select
Columns("D:D").Delete Shift:=xlUp
Columns("G:G").Delete Shift:=xlUp
Columns("D:D").HorizontalAlignment = xlCenter
Range("A1").Select
'*** neue Zeiten
Do While Range("A" & count) <> ""
If Range("A" & count) <> Range("A" & count + 1) Then
anzahl = anzahl + 1
End If
count = count + 1
Loop
Dim lauf(35) As String
'_Texte_markieren_und_hervorheben___________________________________________
Dim h As Integer
h = 1
Columns("I:I").Select
Selection.NumberFormat = "#,##0.00_ ;[Red]-#,##0.00 "  'Zahlen-Formatierung
Columns("G:H").Select
Selection.NumberFormat = "#,##0"
Do While Range("A" & h) <> ""
If Range("D" & h) = "Zwischensumme (Vorab)Dotierung" Then   'Markieren
Range("D" & h).HorizontalAlignment = xlLeft
Rows(h & ":" & h).Font.Bold = True
End If
If Range("C" & h) = "Summe UB" Then                         'Markieren
Range("D" & h).Value = "Summe UB"
Range("D" & h).HorizontalAlignment = xlLeft
Range("A" & h & ":I" & h).Select                        '>> Wieder bis M
With Selection.Interior
.ColorIndex = 35
.Pattern = xlSolid
End With
Rows(h & ":" & h).Font.Bold = True
End If
If Range("B" & h) = "Summe Fachbudget" Then                 'Markieren
Range("A" & h & ":I" & h).Select                        '>> Wieder bis M
With Selection.Interior
.ColorIndex = 37
.Pattern = xlSolid
End With
Rows(h & ":" & h).Font.Bold = True
End If
h = h + 1
Loop
'_Daten_in_neue_Tabelle_kopieren___________________________________________
Dim i As String
Dim j As Integer
Dim run As Integer
run = 0
Dim szeit   'Start- und Endzeit für jeden Durchlauf
Dim ezeit
Do While Range("A2").Text <> ""
szeit = Time
i = Range("A2")     'z.B. gleich 10 (für Blatt-Name)
j = 2               'Startzelle
Do While Range("A" & j) = i
j = j + 1
Loop
Range("A2:M" & j - 1).Cut       ' >> Hier stand von A2 bis Lj = Falsch. Es muss M sein.
Sheets.Add
ActiveSheet.Paste
Rows("1:1").Select
Selection.Insert Shift:=xlDown
Range("A2").Select              'Inhalte ausschneiden und in neue Tab einfügen
Range("A1").FormulaR1C1 = "FB"
Range("B1").FormulaR1C1 = "UB"
Range("C1").FormulaR1C1 = "EA-Art"
Range("D1").FormulaR1C1 = "HHSt."
Range("E1").FormulaR1C1 = "Bezeichnung"
Range("F1").FormulaR1C1 = "VB"
Range("G1").FormulaR1C1 = "Soll 2004"
Range("H1").FormulaR1C1 = "Soll 2003"                                    '>> Dieser Eintrag fehlte komplett
Range("I1").FormulaR1C1 = "Erg. 2002"                                    '>> Alle Anderen sind eine Spalte nach rechts
Range("A1:M1").HorizontalAlignment = xlCenter   'Überschriften zentrieren
Range("A1:M1").VerticalAlignment = xlCenter
Range("A1:M1").Font.Bold = True
ActiveSheet.Name = i
'Spaltenbreiten festlegen
Columns("A:A").ColumnWidth = 3
Columns("B:B").ColumnWidth = 2.14
Columns("C:C").ColumnWidth = 11
Columns("D:D").ColumnWidth = 11.29 'zentriert
Columns("E:E").ColumnWidth = 34.29 'Breite veränderbar
Columns("F:F").ColumnWidth = 2.86
Columns("G:G").ColumnWidth = 12.71
Columns("H:H").ColumnWidth = 12.71
Columns("I:I").ColumnWidth = 15.43
Columns("E:E").Select
With Selection
.WrapText = True
.Orientation = 0
.ShrinkToFit = False    'Zeilenhöhe nochmal korrigieren
.MergeCells = False
End With
Cells.Select
Cells.EntireRow.AutoFit
Columns("A:A").EntireColumn.Hidden = True        'ausblenden
Columns("C:C").EntireColumn.Hidden = True
ActiveSheet.PageSetup.CenterHeader = "Budget " & i      'Kopfzeile
If frage = vbYes Then
ActiveSheet.PageSetup.LeftMargin = Application.InchesToPoints(0.393700787401575)    'Seitenränder auf 1 cm
ActiveSheet.PageSetup.RightMargin = Application.InchesToPoints(0.393700787401575)
ActiveSheet.PageSetup.TopMargin = Application.InchesToPoints(0.78740157480315)
ActiveSheet.PageSetup.BottomMargin = Application.InchesToPoints(0.78740157480315)
End If
'Gitternetzlinien einzeichnen lassen
Range("A1:I" & j - 1).Select
Selection.Borders(xlEdgeLeft).LineStyle = xlContinuous
Selection.Borders(xlEdgeTop).LineStyle = xlContinuous
Selection.Borders(xlEdgeBottom).LineStyle = xlContinuous
Selection.Borders(xlEdgeRight).LineStyle = xlContinuous
Selection.Borders(xlInsideVertical).LineStyle = xlContinuous
Selection.Borders(xlInsideHorizontal).LineStyle = xlContinuous
'*******Zahlen neu berechnen************************************************
Dim l
l = 1
Dim summe_ub_03_ein As Double
Dim summe_ub_02_ein As Double
Dim summe_ub_03_aus As Double
Dim summe_ub_02_aus As Double
Dim summe_fb_03 As Double
Dim summe_fb_02 As Double
Dim end_03 As Double
Dim end_02 As Double
' für das einfügen der Formeln
Dim ein_von As Double
Dim ein_bis As Double
Dim aus_von As Double
Dim aus_bis As Double
Dim nur_aus As Boolean 'nur Ausgaben
Dim nur_ein As Boolean 'nur Einnahmen
nur_aus = False
nur_ein = False
Dim einmal As Boolean
einmal = False
ein_von = l + 1 'Zähler L für die Zeile
ein_bis = 0
aus_von = l
aus_bis = 0
summe_ub_03_ein = 0
summe_ub_02_ein = 0
summe_ub_03_aus = 0
summe_ub_02_aus = 0
summe_fb_03 = 0
summe_fb_02 = 0
end_03 = 0
end_02 = 0
Columns("I:I").Select
Selection.NumberFormat = "#,##0.00_ ;[Red]-#,##0.00 "
Range("A1").Select
'nicht vorab dotiert
Do While Range("A" & l) <> ""
'fürs Eintragen der Formel in Summe UB
Dim zw1 As Double
Dim zw2 As Double
'fürs Erstellen der Formeln
If Range("C" & l) = "Einnahme" And Range("D" & l) <> "" And Range("D" & l) <> "Zwischensumme (Vorab)Dotierung" Then
ein_bis = ein_bis + 1
End If
If Range("C" & l) = "Ausgabe" And Range("D" & l) <> "" And Range("D" & l) <> "Zwischensumme (Vorab)Dotierung" Then
aus_bis = aus_bis + 1
End If
If Range("D" & l) = "Zwischensumme (Vorab)Dotierung" Then
If einmal = False And Range("C2").Value = "Ausgabe" Then    'nur wenn am anfang
aus_von = aus_von + 1                                   'keine einnahme steht
'aus_bis = aus_bis + 1
End If
If Range("C" & l) = "Einnahme" Then
ein_bis = ein_von + ein_bis - 1
Range("G" & l).Formula = "=SUM(G" & ein_von & ":G" & ein_bis & ")"
aus_von = l + 1
zw1 = l 'L für Zeile ZWS-Ein
'If Range("C" & l + 1) <> "Ausgabe" Then
'    Range("G" & l).Formula = "=G" & zw1
'End If
End If
If Range("C" & l) = "Ausgabe" Then
aus_bis = aus_von + aus_bis - 1
Range("G" & l).Formula = "=SUM(G" & aus_von & ":G" & aus_bis & ")"
ein_von = l + 2
zw2 = l 'L für Zeile ZWS-Aus
End If
ein_bis = 0
aus_bis = 0
End If
'Einnahmen hochzählen
If Range("C" & l) = "Einnahme" And Range("D" & l) = "Zwischensumme (Vorab)Dotierung" Then
summe_ub_03_ein = Range("H" & l).Value
summe_ub_02_ein = Range("I" & l).Value
End If
'Ausgaben hochzählen
If Range("C" & l) = "Ausgabe" And Range("D" & l) = "Zwischensumme (Vorab)Dotierung" Then
summe_ub_03_aus = Range("H" & l).Value
summe_ub_02_aus = Range("I" & l).Value
End If
If Range("C" & l) = "Summe UB" Then
summe_fb_03 = summe_ub_03_ein - summe_ub_03_aus
Range("H" & l).Value = summe_fb_03
end_03 = end_03 + summe_fb_03
summe_fb_02 = summe_ub_02_ein - summe_ub_02_aus
Range("I" & l).Value = summe_fb_02
end_02 = end_02 + summe_fb_02
If nur_ein = True Then
Range("G" & l).Formula = "=G" & zw1
Else: Range("G" & l).Formula = "=SUM(G" & zw1 & "-G" & zw2 & ")"
If nur_aus = True Then
Range("G" & l).Formula = "=G" & zw2
Else: Range("G" & l).Formula = "=SUM(G" & zw1 & "-G" & zw2 & ")"
If einmal = False And Range("C2").Value = "Ausgabe" Then    'nur wenn am anfang
Range("G" & l).Formula = "=G" & zw2                     'keine einnahme steht
einmal = True
End If
End If
nur_ein = False
nur_aus = False
If Range("C" & l + 1) = "Ausgabe" Then
aus_von = l + 1
nur_aus = True
End If
End If
If Range("B" & l) = "Summe Fachbudget" Then
Dim zwcount As Integer
Dim zwstr As String
zwstr = "=SUM(G"
zwcount = 1
Do While Range("B" & zwcount) <> ""
If Range("D" & zwcount) = "Summe UB" Then
zwstr = zwstr & CStr(zwcount & "+G")
End If
If Range("B" & zwcount) = "Summe Fachbudget" Then
zwstr = Left(zwstr, Len(zwstr) - 2) & ")"
End If
zwcount = zwcount + 1
Loop
Range("H" & l).Value = end_03
Range("I" & l).Value = end_02
Range("G" & l).Formula = CStr(zwstr)
End If
l = l + 1
Loop
Rows(j + 1 & ":" & j + 1).Select
Selection.Insert Shift:=xlDown
ActiveSheet.PageSetup.PrintTitleRows = "$1:$1"      'Wiederholungszeile einfügen
Range("G2").Select
Columns("G:G").Select           '*** BLATTSCHUTZ
Selection.Locked = False
Selection.FormulaHidden = False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Range("G2").Select
Sheets("Budgetauswertung").Select
Rows("2:" & j - 1).Delete Shift:=xlUp  'leere Zellen löschen
ezeit = Time
lauf(run) = CDate(ezeit - szeit)
ergebnis = ergebnis & i & " : " & CStr(lauf(run)) & Chr(13)
run = run + 1
Loop
Sheets("Budgetauswertung").Select       '(leere) Ursprungstabelle löschen
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
Sheets("Summe Verwaltungshaushalt").Select  '(leere) Tabelle löschen
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
Sheets("10").Select             'zur ersten Tabelle springen (immer 10)
Range("A2").Select
zeit_off = Time
zeit_diff = CDate(zeit_off - zeit_on)
If frage2 = vbYes Then
ActiveWindow.WindowState = xlMaximized
End If
'MsgBox ergebnis
temp = MsgBox(" Fertig" & Chr(13) & Chr(13) & "Die Auswertung ist abgeschlossen!" & Chr(13) & Chr(13) & "Gesamtdauer: " & CStr(zeit_diff) & Chr(13) & Chr(13) & "Benötigte Einzel-Zeiten (pro Budget) anzeigen?", vbYesNo, "Discoverer-Auswertung 4.0 by KrickelD")
If temp = vbYes Then
temp = MsgBox("Benötigte Arbeitszeit pro Tabellenblatt:" & Chr(13) & Left(ergebnis, (Len(ergebnis) / 2) - 5), vbOKOnly, "Discoverer-Auswertung 4.0 by KrickelD (1/2)")
temp = MsgBox(Right(ergebnis, (Len(ergebnis) / 2) + 5), vbOKOnly, "Discoverer-Auswertung 4.0 by KrickelD (2/2)")
End If
End Sub


'*** Ende ***
Anzeige

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Wer soll sich da durchwühlen???? oT
23.09.2003 13:10:56
xXx
AW: Loop ohne Do - STIMMT NICHT!
23.09.2003 13:18:10
Hajo_Zi
Hallo

ist Dir schon mal aufgefallen das die meisten hier min. einen Vornamen schreiben.

Die Fehlermeldung muß man nicht so genau nehmen es kann auch ein End if fehlen oder zuviel sein. bis dahin habe ich mich durchgearbeitet

Option Explicit


Sub liste_mittel_aufteilen()
'Seitenränder mit berücksichtigen
Dim frage
frage = MsgBox("Los gehts!" & Chr(13) & Chr(13) & "Sollen die Seitenränder gleich mit verkleinert werden (dauert länger)", vbYesNo, "Discoverer-Auswertung 4.0 by KrickelD")
Dim frage2
'frage2 = MsgBox("Und soll die aktive Tabelle während des Ablaufes minimiert werden? (geht noch schneller)", vbYesNo, "Discoverer-Auswertung 4.0 by KrickelD")
frage2 = vbYes 'Nur für Test-Zwecke
If frage2 = vbYes Then ActiveWindow.WindowState = xlMinimized
'für die einzelnen Zeitberechnungen
Dim ergebnis As String, feld As Integer, anzahl As Integer, count As Integer
ergebnis = ""
feld = 0
anzahl = 0
count = 1
Dim zeit_on
Dim zeit_off
Dim zeit_diff
zeit_on = Time
Dim temp
'Vorformatierungen
Range("I5:K5").Select
Selection.Cut Destination:=Range("I6:K6")
Rows("1:5").Select
Range("A1").Activate
Selection.Delete Shift:=xlUp
Columns("L:L").Delete Shift:=xlUp
Range("A1").Select
'Ursprungstabelle wegsichern
Sheets("Budgetauswertung").Select
Sheets("Budgetauswertung").Copy After:=Sheets(1)
Sheets("Budgetauswertung (2)").Name = "Ursprungstabelle"
Sheets("Budgetauswertung").Select
Range("A1").Select
Columns("D:D").Delete Shift:=xlUp
Columns("G:G").Delete Shift:=xlUp
Columns("D:D").HorizontalAlignment = xlCenter
Range("A1").Select
'*** neue Zeiten
Do While Range("A" & count) <> ""
If Range("A" & count) <> Range("A" & count + 1) Then anzahl = anzahl + 1
count = count + 1
Loop
Dim lauf(35) As String
'_Texte_markieren_und_hervorheben___________________________________________
Dim h As Integer
h = 1
Columns("I:I").Select
Selection.NumberFormat = "#,##0.00_ ;[Red]-#,##0.00 "  'Zahlen-Formatierung
Columns("G:H").Select
Selection.NumberFormat = "#,##0"
Do While Range("A" & h) <> ""
If Range("D" & h) = "Zwischensumme (Vorab)Dotierung" Then   'Markieren
Range("D" & h).HorizontalAlignment = xlLeft
Rows(h & ":" & h).Font.Bold = True
End If
If Range("C" & h) = "Summe UB" Then                         'Markieren
Range("D" & h).Value = "Summe UB"
Range("D" & h).HorizontalAlignment = xlLeft
Range("A" & h & ":I" & h).Select                        '>> Wieder bis M
With Selection.Interior
.ColorIndex = 35
.Pattern = xlSolid
End With
Rows(h & ":" & h).Font.Bold = True
End If
If Range("B" & h) = "Summe Fachbudget" Then                 'Markieren
Range("A" & h & ":I" & h).Select                        '>> Wieder bis M
With Selection.Interior
.ColorIndex = 37
.Pattern = xlSolid
End With
Rows(h & ":" & h).Font.Bold = True
End If
h = h + 1
Loop
'_Daten_in_neue_Tabelle_kopieren___________________________________________
Dim i As String
Dim j As Integer
Dim run As Integer
run = 0
Dim szeit   'Start- und Endzeit für jeden Durchlauf
Dim ezeit
Do While Range("A2").Text <> ""
szeit = Time
i = Range("A2")     'z.B. gleich 10 (für Blatt-Name)
j = 2               'Startzelle
Do While Range("A" & j) = i
j = j + 1
Loop
Range("A2:M" & j - 1).Cut       ' >> Hier stand von A2 bis Lj = Falsch. Es muss M sein.
Sheets.Add
ActiveSheet.Paste
Rows("1:1").Select
Selection.Insert Shift:=xlDown
Range("A2").Select              'Inhalte ausschneiden und in neue Tab einfügen
Range("A1").FormulaR1C1 = "FB"
Range("B1").FormulaR1C1 = "UB"
Range("C1").FormulaR1C1 = "EA-Art"
Range("D1").FormulaR1C1 = "HHSt."
Range("E1").FormulaR1C1 = "Bezeichnung"
Range("F1").FormulaR1C1 = "VB"
Range("G1").FormulaR1C1 = "Soll 2004"
Range("H1").FormulaR1C1 = "Soll 2003"                                    '>> Dieser Eintrag fehlte komplett
Range("I1").FormulaR1C1 = "Erg. 2002"                                    '>> Alle Anderen sind eine Spalte nach rechts
Range("A1:M1").HorizontalAlignment = xlCenter   'Überschriften zentrieren
Range("A1:M1").VerticalAlignment = xlCenter
Range("A1:M1").Font.Bold = True
ActiveSheet.Name = i
'Spaltenbreiten festlegen
Columns("A:A").ColumnWidth = 3
Columns("B:B").ColumnWidth = 2.14
Columns("C:C").ColumnWidth = 11
Columns("D:D").ColumnWidth = 11.29 'zentriert
Columns("E:E").ColumnWidth = 34.29 'Breite veränderbar
Columns("F:F").ColumnWidth = 2.86
Columns("G:G").ColumnWidth = 12.71
Columns("H:H").ColumnWidth = 12.71
Columns("I:I").ColumnWidth = 15.43
Columns("E:E").Select
With Selection
.WrapText = True
.Orientation = 0
.ShrinkToFit = False    'Zeilenhöhe nochmal korrigieren
.MergeCells = False
End With
Cells.Select
Cells.EntireRow.AutoFit
Columns("A:A").EntireColumn.Hidden = True        'ausblenden
Columns("C:C").EntireColumn.Hidden = True
ActiveSheet.PageSetup.CenterHeader = "Budget " & i      'Kopfzeile
If frage = vbYes Then
ActiveSheet.PageSetup.LeftMargin = Application.InchesToPoints(0.393700787401575)    'Seitenränder auf 1 cm
ActiveSheet.PageSetup.RightMargin = Application.InchesToPoints(0.393700787401575)
ActiveSheet.PageSetup.TopMargin = Application.InchesToPoints(0.78740157480315)
ActiveSheet.PageSetup.BottomMargin = Application.InchesToPoints(0.78740157480315)
End If
'Gitternetzlinien einzeichnen lassen
Range("A1:I" & j - 1).Select
Selection.Borders(xlEdgeLeft).LineStyle = xlContinuous
Selection.Borders(xlEdgeTop).LineStyle = xlContinuous
Selection.Borders(xlEdgeBottom).LineStyle = xlContinuous
Selection.Borders(xlEdgeRight).LineStyle = xlContinuous
Selection.Borders(xlInsideVertical).LineStyle = xlContinuous
Selection.Borders(xlInsideHorizontal).LineStyle = xlContinuous
'*******Zahlen neu berechnen************************************************
Dim l
l = 1
Dim summe_ub_03_ein As Double
Dim summe_ub_02_ein As Double
Dim summe_ub_03_aus As Double
Dim summe_ub_02_aus As Double
Dim summe_fb_03 As Double
Dim summe_fb_02 As Double
Dim end_03 As Double
Dim end_02 As Double
' für das einfügen der Formeln
Dim ein_von As Double
Dim ein_bis As Double
Dim aus_von As Double
Dim aus_bis As Double
Dim nur_aus As Boolean 'nur Ausgaben
Dim nur_ein As Boolean 'nur Einnahmen
nur_aus = False
nur_ein = False
Dim einmal As Boolean
einmal = False
ein_von = l + 1 'Zähler L für die Zeile
ein_bis = 0
aus_von = l
aus_bis = 0
summe_ub_03_ein = 0
summe_ub_02_ein = 0
summe_ub_03_aus = 0
summe_ub_02_aus = 0
summe_fb_03 = 0
summe_fb_02 = 0
end_03 = 0
end_02 = 0
Columns("I:I").Select
Selection.NumberFormat = "#,##0.00_ ;[Red]-#,##0.00 "
Range("A1").Select
'nicht vorab dotiert
Do While Range("A" & l) <> ""
'fürs Eintragen der Formel in Summe UB
Dim zw1 As Double
Dim zw2 As Double
'fürs Erstellen der Formeln
If Range("C" & l) = "Einnahme" And Range("D" & l) <> "" And Range("D" & l) <> "Zwischensumme (Vorab)Dotierung" Then
ein_bis = ein_bis + 1
End If
If Range("C" & l) = "Ausgabe" And Range("D" & l) <> "" And Range("D" & l) <> "Zwischensumme (Vorab)Dotierung" Then
aus_bis = aus_bis + 1
End If
If Range("D" & l) = "Zwischensumme (Vorab)Dotierung" Then
If einmal = False And Range("C2").Value = "Ausgabe" Then    'nur wenn am anfang
aus_von = aus_von + 1                                   'keine einnahme steht
'aus_bis = aus_bis + 1
End If
If Range("C" & l) = "Einnahme" Then
ein_bis = ein_von + ein_bis - 1
Range("G" & l).Formula = "=SUM(G" & ein_von & ":G" & ein_bis & ")"
aus_von = l + 1
zw1 = l 'L für Zeile ZWS-Ein
'If Range("C" & l + 1) <> "Ausgabe" Then
'    Range("G" & l).Formula = "=G" & zw1
'End If
End If
If Range("C" & l) = "Ausgabe" Then
aus_bis = aus_von + aus_bis - 1
Range("G" & l).Formula = "=SUM(G" & aus_von & ":G" & aus_bis & ")"
ein_von = l + 2
zw2 = l 'L für Zeile ZWS-Aus
End If
ein_bis = 0
aus_bis = 0
End If
End Sub



Falls Code vorhanden wurde dieser getestet unter Betriebssystem XP Pro und Excel Version XP SBE.
Bitte kein Mail, Probleme sollen im Forum gelöst werden.

Microsoft MVP für Excel

Das Forum lebt auch von den Rückmeldungen.

Zurzeit gibt es wieder Probleme mit der E-Mail Benachrichtigung.

Ich bekomme Mails zu Beiträgen an denen ich nicht beteiligt bin und zusätzlich noch Mails zu meinen eigenen Beiträgen.
Das Problem mit den eigenen Benachrichtigung kann gelöst werden durch Lösche und Neuanmelden. Dieses möchte ich aber nicht jeden Tag machen.
Um dieses Problem erstmal zu beseitigen habe ich die automatische Mailbenachrichtigung abgeschaltet.
Aus diesem Grunde ist es dem Zufall überlassen ob auf Rückfragen Antworten von mir kommen.


http://home.media-n.de/ziplies/

Anzeige
AW: Loop ohne Do - STIMMT NICHT!
23.09.2003 13:31:12
Daniel (KrickelD)
Ich habs gefunden:

If Range("C" & l + 1) = "Ausgabe" Then
aus_von = l + 1
nur_aus = True
End If

und danach kommt NOCH EIN _end if_ !!!

Trotzdem danke für den Tip, mfg Daniel (alias KrickelD)
Danke für Rückmeldung
23.09.2003 13:33:52
Hajo_Zi
Hallo Daniel

sagt mein Beitrag was anderes???


Falls Code vorhanden wurde dieser getestet unter Betriebssystem XP Pro und Excel Version XP SBE.
Bitte kein Mail, Probleme sollen im Forum gelöst werden.

Microsoft MVP für Excel

Das Forum lebt auch von den Rückmeldungen.

http://home.media-n.de/ziplies/

Anzeige
AW: Loop ohne Do - STIMMT NICHT!
23.09.2003 13:37:11
Galenzo
Hallo,
hab' mir eben mal dieses Teil von VBA-Code angeschaut. Hmmmm..... naja....
Zunächst sind mir die If..Then..Else- Anweisungen aufgefallen.
Deine Schreibweise mit "..Else: Anweisung.." scheinen mir nicht korrekt formuliert.
Verwende die komplette Schreibweise:
if .... then
....
else
....
end if

Weiterhin solltest du die Einrückungen konsequent durchhalten: ich habe mal angefangen
den Code neu einzurücken und da ist auch gleich ein "End if" übriggeblieben.
Wenn du alle Dim-Anweisungen an den Anfang der Prozedur stellst, wird das ganze noch übersichtlicher.
Viel Erfolg.
Anzeige
;

Forumthreads zu verwandten Themen

Anzeige
Anzeige
Anzeige

Infobox / Tutorial

Loop-Problematik in Excel VBA: Fehlerbehebung und Tipps


Schritt-für-Schritt-Anleitung

  1. Fehlermeldung identifizieren: Wenn du die Fehlermeldung "Loop ohne Do" erhältst, ist es wichtig, den Code genau zu überprüfen. In deinem VBA-Code sollte jeder Do ein passendes Loop haben.

  2. Überprüfen der Struktur: Achte darauf, dass alle If-Anweisungen korrekt geöffnet und geschlossen sind. Zum Beispiel:

    If Bedingung Then
       ' Code
    Else
       ' Alternativer Code
    End If
  3. Einrückungen nutzen: Halte den Code gut strukturiert und nutze Einrückungen, um die Lesbarkeit zu verbessern. Das hilft dir, Fehler leichter zu erkennen.

  4. Debugging: Nutze die Debugging-Tools von Excel, um den Code Schritt für Schritt durchzugehen. Setze Breakpoints, um den Ablauf zu überwachen.


Häufige Fehler und Lösungen

  • Fehlendes End If: Eine häufige Ursache für die Fehlermeldung ist ein vergessenes End If. Stelle sicher, dass jede If-Anweisung ein passendes End If hat.

  • Mismatch von Do und Loop: Überprüfe, ob jede Do While-Schleife auch ein entsprechendes Loop hat. Zähle die Anzahl der Do- und Loop-Anweisungen, um sicherzustellen, dass sie übereinstimmen.

  • Falsche Verwendung von Else: Achte darauf, die Else-Anweisungen nicht mit einem Doppelpunkt : zu trennen. Verwende die vollständige Schreibweise.


Alternative Methoden

  • Verwendung von For-Schleifen: In vielen Fällen kannst du anstelle von Do While eine For-Schleife verwenden, um die Lesbarkeit zu erhöhen und Fehler zu vermeiden. Zum Beispiel:

    For i = 1 To 10
       ' Code
    Next i
  • Sub-Prozeduren: Teile deinen Code in kleinere Sub-Prozeduren auf. Das vereinfacht das Debugging und macht den Code übersichtlicher.


Praktische Beispiele

Hier ist ein angepasstes Beispiel, wie du eine Schleife richtig nutzen kannst:

Sub Beispiel()
    Dim count As Integer
    count = 1
    Do While Range("A" & count).Value <> ""
        ' Dein Code hier
        count = count + 1
    Loop
End Sub

Achte darauf, dass count innerhalb der Schleife aktualisiert wird, um eine Endlosschleife zu vermeiden.


Tipps für Profis

  • Code-Überprüfung: Lass deinen Code von einem Kollegen oder einer Kollegin überprüfen. Ein frischer Blick kann oft Fehler aufdecken, die du übersehen hast.

  • Kommentare nutzen: Verwende Kommentare, um komplexe Abschnitte deines Codes zu erklären. Das erleichtert die Wartung und das Verständnis.

  • Versionierung: Halte verschiedene Versionen deines Codes, sodass du bei Fehlern schnell auf vorherige funktionierende Versionen zurückgreifen kannst.


FAQ: Häufige Fragen

1. Was bedeutet "Loop ohne Do"? Diese Fehlermeldung tritt auf, wenn die Struktur des Codes nicht korrekt ist, meist weil ein Do fehlt, das zu einem Loop gehört.

2. Wie kann ich meine VBA-Fehler schneller finden? Nutze die Debugging-Tools in Excel, um den Code Schritt für Schritt auszuführen. Setze Breakpoints und beobachte die Variablenwerte.

3. Ist es besser, Do While oder For-Schleifen zu verwenden? Das hängt von deinem spezifischen Anwendungsfall ab. For-Schleifen sind oft besser lesbar, während Do While flexibler sein kann, wenn die Anzahl der Iterationen nicht im Voraus bekannt ist.

4. Können Kommentare die Leistung beeinträchtigen? Nein, Kommentare sind nur für die Lesbarkeit des Codes und beeinflussen die Ausführung nicht.

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige