Das Archiv des Excel-Forums

Loop ohne Do - STIMMT NICHT!

Bild

Betrifft: Loop ohne Do - STIMMT NICHT!
von: KrickelD

Geschrieben am: 23.09.2003 13:03:57

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 ***
Bild


Betrifft: Wer soll sich da durchwühlen???? oT
von: xXx
Geschrieben am: 23.09.2003 13:10:56




Bild


Betrifft: AW: Loop ohne Do - STIMMT NICHT!
von: Hajo_Zi
Geschrieben am: 23.09.2003 13:18:10

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/



Bild


Betrifft: AW: Loop ohne Do - STIMMT NICHT!
von: Daniel (KrickelD)
Geschrieben am: 23.09.2003 13:31:12

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)


Bild


Betrifft: Danke für Rückmeldung
von: Hajo_Zi
Geschrieben am: 23.09.2003 13:33:52

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/



Bild


Betrifft: AW: Loop ohne Do - STIMMT NICHT!
von: Galenzo
Geschrieben am: 23.09.2003 13:37:11

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.


 Bild

Excel-Beispiele zum Thema " Loop ohne Do - STIMMT NICHT!"

Befindet sich die aktive Zelle in einem bestimmten Bereich? download Werte eins bestimmten Monats summieren download
Werte 1 und 0 in einem bestimmten Verhältnis zufällig anordnen download Alle Links zu einer bestimmten Arbeitsmappe löschen download
Anzahl eines bestimmten Wochentages im Monat download Alle Dateien ab einem bestimmten Datum listen download
Daten eines bestimmten Jahres filtern download Word mit bestimmtem Dokument starten download
Bestimmte Anzahl von Zeichen zulassen download Zeilen löschen, wenn in bestimmten Spalten keine Werte stehen download
Zeile löschen, wenn ein bestimmter Wert vorkommt download xlSaveAs-Dialog in einem bestimmten Verzeichnis aufrufen download
Nur Zeilen mit bestimmtem Inhalt in HTML-Datei konvertieren download Kommentarfenster in bestimmter Größe erstellen download
Wert einer bestimmten Zelle merken download Werte aus UserForm-TextBox in bestimmten Formate übertragen download
Feststellen, ob eine bestimmte Zelle markiert ist download Anzahl von Zellen mit einer bestimmten Hintergrundfarbe ermitteln download
Zeichenfolgen ändern, wenn ein sie einen bestimmten Text enthalten download Werte eines bestimmten Wochentages und eines Zeitbereiches addieren download
Bestimmte Zeichen in einer UserForm-TextBox markieren download Bei Aktivierung einer bestimmten Tabelle in Vollbildmodus schalten download
Cursor in bestimmtem Zellbereich in Eieruhr verwandeln download Anzahl eines Namens in einer bestimmten Schriftfarbe ermitteln download
Anzahl der Einträge zu einer bestimmten Kalenderwoche download Hintergrundfarbe einer Zeile, wenn bestimmter Wert in 1 Zelle download
Errechnung der Maximaltemperatur an bestimmtem Datum download Datenmaske mit einem bestimmten Datensatz aufrufen download
Nur Zeilen mit bestimmtem Inhalt kopieren download Aus Liste Anzahl der Januartage eines bestimmten Jahres listen download
Einem Datum eine bestimmte Anzahl von Jahren hinzufügen download Letzte Zeile mit einem bestimmten Anfangsbuchstaben markieren download
Seitenumbruch nach Zeilen mit bestimmtem Inhalt einfügen download Bestimmte Wochentage ohne Feiertage listen download
Dateien mit bestimmtem Inhalt suchen download