Anzeige
Archiv - Navigation
1160to1164
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Schleife vereinfachen
Holger
Hallo Excelfreunde,
wie kann ich das nachfolgende Code-Ungetüm vereinfachen?
Auf den Blatt s2a stehen chronologisch sortiert Beträge. In Spalte B steht immer das Datum, in Spalte D die positiven Beträge und in Spalte E die negativen Beträge (aber ohne Vorzeichen). Pro Zeile gibt es immer nur ein Betrag, entweder in Spalte D oder in E.
Der Code soll jetzt alle Beträge Pro Tag der Spalte D summieren, dann die Beträge der Spalte E Abziehen und ein Tagessaldo (wenn negativ, dann mit Vorzeichen) auf Blatt s2c ausgeben. Dann den nächsten Tag u.s.w.
Sub Tagsumme()
'Der nachfolgende Teil summiert die Einzelbuchungen vom Tabellenblatt (s2a) und gibt die
'Tagessummen auf dem Tabellenblatt (s2c) aus.
Dim s2a$,  s2c$, a, b, e
s2a = "Import"
s2c = "Tagessalden"
a = 1
e = 1
Anweisung1:
b = 0
On Error GoTo Anweisung2
While Worksheets(s2a).Cells(a, 2) = Worksheets(s2a).Cells(a + 1, 2)
b = b + Worksheets(s2a).Cells(a, 4) - Worksheets(s2a).Cells(a, 5)
Worksheets(s2c).Cells(e, 1) = Worksheets(s2a).Cells(a, 2)
Worksheets(s2c).Cells(e, 2) = b
a = a + 1
Wend
If Worksheets(s2a).Cells(a, 2) = Worksheets(s2a).Cells(a - 1, 2) Then
b = b + Worksheets(s2a).Cells(a, 4) - Worksheets(s2a).Cells(a, 5)
Worksheets(s2c).Cells(e, 1) = Worksheets(s2a).Cells(a, 2)
Worksheets(s2c).Cells(e, 2) = b
End If
If Worksheets(s2a).Cells(a, 2)  Worksheets(s2a).Cells(a - 1, 2) And _
Worksheets(s2a).Cells(a, 2)  Worksheets(s2a).Cells(a + 1, 2) Then
b = b + Worksheets(s2a).Cells(a, 5) - Worksheets(s2a).Cells(a, 6)
Worksheets(s2c).Cells(e, 1) = Worksheets(s2a).Cells(a, 2)
Worksheets(s2c).Cells(e, 2) = b
End If
e = e + 1
a = a + 1
If Worksheets(s2a).Cells(a, 2)  "" Then GoTo Anweisung1
MsgBox ("Die Berechnung ist jetzt fertig")
Sheets(s2b).Select
Range("A1").Select
Application.ScreenUpdating = True
Exit Sub
Anweisung2:
MsgBox ("Es ist ein Fehler aufgetreten! Bitte überprüfen Sie das Makro")
End Sub

Gruß Holger

10
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Schleife vereinfachen
09.06.2010 11:39:50
Rudi
Hallo,
warum machst du das nicht einfach mit einer Pivot-Tabelle?
Gruß
Rudi
AW: Schleife vereinfachen
09.06.2010 13:17:04
Holger
Hallo Rudi,
leider ist der Weg über Pivot-Tabellen zu kompliziert. Das Makro wird aus einer externen Arbeitsmappe aus gestartet und bearbeitet je nach Ereignis veschiedene Ziel-Arbeitsmappen, also müsste ich in jeder dieser Ziel-Mappen eine Pivottabelle einpflegen. Und Änderungen könnte ich nicht zentral durchführen, sondern müsste jede Pivottabelle wieder anpacken.
Gruß Holger
AW: Schleife vereinfachen
09.06.2010 11:59:33
Yusuf
Moin,
vielleicht kannst ja das in dein Makro einbauen.
https://www.herber.de/bbs/user/69973.xls
Gruß
Yusuf
Anzeige
AW: Schleife vereinfachen
09.06.2010 13:21:55
Holger
Hallo Yusuf,
leider kann ich dein Beispiel nicht in meinem Makro benutzen. Dein Code verlangt z.B. Spaltenüberschriften, die aber nicht vorhanden sind. Aber das ist nur ein Hindernis.
Trotzdem finde ich deine Idee sehr gut und werde sie auf jeden Fall im Hinterkopf behalten.
Danke für deine Mühe!
Gruß Holger
AW: Schleife vereinfachen
09.06.2010 13:03:09
fcs
Hallo Holger,
Code-Ungetüm ist halt immer relativ. Auf alle Fälle solltest du aber mit etwas aussagekräftigeren Variablennamen als a, b und e arbeiten.
Nachfolgend eine Variante mit einer For-Next-Schleife.
Gruß
Franz
Sub Tagsumme()
'Der nachfolgende Teil summiert die Einzelbuchungen vom Tabellenblatt (s2a) und gibt die
'Tagessummen auf dem Tabellenblatt (s2c) aus.
Dim wksImport As Worksheet, wksSalden As Worksheet
Dim dDatum As Date, Zeile_Import As Long, Zeile_Salden As Long
Dim dblSaldo As Double
On Error GoTo Fehler
Set wksImport = Worksheets("Import")
Set wksSalden = Worksheets("Tagessalden")
Application.ScreenUpdating = False
With wksImport
Zeile_Salden = 1 'Zeile ab der im Salden-Blatt Werte eingetragen werden sollen
Zeile_Import = 1 '1. Zeile mit Datum im Blatt "Import"
dDatum = .Cells(Zeile_Import, 2) 'Startdatum merken
For Zeile_Import = Zeile_Import To .Cells(.Rows.Count, 2).End(xlUp)
If .Cells(Zeile_Import, 2)  dDatum Then
'Datum + Saldo im Blatt Tagessalden eintragen
With wksSalden
.Cells(Zeile_Salden, 1) = dDatum
.Cells(Zeile_Salden, 2) = dblSaldo
Zeile_Salden = Zeile_Salden + 1
End With
'Startwerte neu setzen
dDatum = .Cells(Zeile_Import, 2)
dblSaldo = 0
End If
dblSaldo = dblSaldo + .Cells(Zeile_Import, 4).Value - .Cells(Zeile_Import, 5).Value
Next
End With
Application.ScreenUpdating = True
MsgBox ("Die Berechnung ist jetzt fertig")
wksSalden.Activate
Range("A1").Select
Fehler:
With Err
Select Case .Number
Case 0
Case 13 'Typ-Fehler z.B. Kein Datum in Spalte B
Zeile_Import = Zeile_Import + 1
Resume
Case Else
MsgBox "Fehler-Nr: " & .Number & vbNewLine & .Description
End Select
End With
Application.ScreenUpdating = True
End Sub

Anzeige
AW: Schleife vereinfachen
09.06.2010 13:39:17
Holger
Hallo Franz,
vielen Dank für die Arbeit, die du dir gemacht hast!
Dein Code ist zwar nicht kürzer, aber dafür wesentlich verständlicher für mich. Und bis auf die Fehlerroutine funktioniert er sehr gut und ist auch schneller als der alte Code.
Zur Fehlerroutine: Egal ob ich ein Datum, mehrere oder die ganze Spalte lösche, das Makro merkt es nicht. Allerdings ist die Ausgabe auf dem Zielblatt dann fehlerhaft.
Gruß Holger
AW: Schleife vereinfachen
09.06.2010 14:41:04
fcs
Hallo Holger,
solange dein Gesamtplan nicht bekannt ist, kann das Makro auch nicht alle Eventualitäten prüfen und berücksichtigen.
Welche Fehler ggf. besonders geprüft werden müssen merkt man meistens erst im Einsatz. Durch Ergänzen entsprechender Case-Zeilen kann man dann entsprechend den Ablauf steuern.
Wenn du zu Beginn der Makros mit einem leeren Saldenblatt starten möchtest, dann muss halt vor dem Übertragen der Tagessalden eine entsprechende Anweisung eingefügt werden.
Außerdem hab ich den Schleifenzähler korrigiert. Die Ausführung solte jetzt noch wesentlich schneller sein.
Gruß
Franz
Sub Tagsumme()
'Der nachfolgende Teil summiert die Einzelbuchungen vom Tabellenblatt (s2a) und gibt die
'Tagessummen auf dem Tabellenblatt (s2c) aus.
Dim wksImport As Worksheet, wksSalden As Worksheet
Dim dDatum As Date, Zeile_Import As Long, Zeile_Salden As Long
Dim dblSaldo As Double, StatusCalc As Long
On Error GoTo Fehler
Set wksImport = Worksheets("Import")
Set wksSalden = Worksheets("Tagessalden")
Application.ScreenUpdating = False
StatusCalc = Application.Calculation
If StatusCalc  xlCalculationManual Then Application.Calculation = xlCalculationManual
'Altdaten im Saldenblatt löschen
wksSalden.UsedRange.ClearContents
With wksImport
Zeile_Salden = 1 'Zeile ab der im Salden-Blatt Werte eingetragen werden sollen
Zeile_Import = 1 '1. Zeile mit Datum im Blatt "Import"
dDatum = .Cells(Zeile_Import, 2) 'Startdatum merken
For Zeile_Import = Zeile_Import To .Cells(.Rows.Count, 2).End(xlUp).Row
If .Cells(Zeile_Import, 2)  dDatum Then
'Datum + Saldo im Blatt Tagessalden eintragen
With wksSalden
.Cells(Zeile_Salden, 1) = dDatum
.Cells(Zeile_Salden, 2) = dblSaldo
Zeile_Salden = Zeile_Salden + 1
End With
'Startwerte neu setzen
dDatum = .Cells(Zeile_Import, 2)
dblSaldo = 0
End If
dblSaldo = dblSaldo + .Cells(Zeile_Import, 4).Value - .Cells(Zeile_Import, 5).Value
Next
End With
If StatusCalc  Application.Calculation Then Application.Calculation = StatusCalc
Application.ScreenUpdating = True
MsgBox "Die Berechnung ist jetzt fertig"
wksSalden.Activate
Range("A1").Select
Fehler:
With Err
Select Case .Number
Case 0
Case 13 'Typ-Fehler z.B. Kein Datum in Spalte B
Zeile_Import = Zeile_Import + 1
Resume
Case Else
MsgBox "Fehler-Nr: " & .Number & vbNewLine & .Description
End Select
End With
Application.ScreenUpdating = True
End Sub

Anzeige
AW: Schleife vereinfachen
09.06.2010 15:02:39
Holger
Hallo Franz,
wie schon geschrieben läuft dein Code gut. Das Ausschalten der automatische Berechnung habe ich noch eingebaut. Die Löschung der Spalten A:B des Saldenblattes hatte ich schon vorher berücksichtigt.
Aber das mit der Fehlermeldung (Case) habe ich nicht verstanden. Wie müsste ich den Code anpassen, damit er mir einen Fehler auswirft, wenn z.B. auf bei der Tabelle "Import" ein Datum in Spalte B fehlt, obwohl ein Wert in der selben Zeile in Spalte D oder E ist?
Gruß Holger
AW: Schleife vereinfachen
09.06.2010 16:32:05
fcs
Hallo Holger,
du kannst in der For-Next-Schleife eine entsprechende Prüfung einfügen.
Gruß
Franz
    For Zeile_Import = Zeile_Import To .Cells(.Rows.Count, 2).End(xlUp).Row
If Not IsDate(.Cells(Zeile_Import, 2)) Then
'Leere Datums-Zeile überspringen  ?
If MsgBox("Kein Datum in Zeile " & Zeile_Import & vbNewLine _
& "Bei OK werden die weiteren Werte übertragen", vbQuestion + vbOKCancel, _
"Tages-Salden ermitteln") = vbCancel Then Exit For
Else
If .Cells(Zeile_Import, 2)  dDatum Then
'Datum + Saldo im Blatt Tagessalden eintragen
With wksSalden
.Cells(Zeile_Salden, 1) = dDatum
.Cells(Zeile_Salden, 2) = dblSaldo
Zeile_Salden = Zeile_Salden + 1
End With
'Startwerte neu setzen
dDatum = .Cells(Zeile_Import, 2)
dblSaldo = 0
End If
dblSaldo = dblSaldo + .Cells(Zeile_Import, 4).Value - .Cells(Zeile_Import, 5).Value
End If
Next

Anzeige
Danke!
10.06.2010 10:41:10
Holger
Hallo Franz,
du hast dir viel Mühe gemacht, dafür ein dickes DANKE!
Gruß Holger

299 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige