Live-Forum - Die aktuellen Beiträge
Datum
Titel
16.04.2024 09:22:11
Wenn Istleer über mehrere Blätter
15.04.2024 23:32:21
Darstellung im IMAGE sehr schlecht
15.04.2024 21:08:34
PDF mit Makro erstellen mehrere Sheets
15.04.2024 18:38:39
Arbeitszeiten Vorlage ergänzen
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1596to1600
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1596to1600
1596to1600
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Fehler im Makro - Summe berechnen

Fehler im Makro - Summe berechnen
15.12.2017 15:01:45
Hans
Hallo Forum,
ich hab mir mit eurer Hilfe ein Makro erstellt das die Dateinamen von Excel Dateien ausliest. Soweit geht das ganz gut.
Am Ende der Tabelle wird dann eine Gesamtsumme berechnet.
Nun meine Frage.
Bei Erstellung bis zu 3 Rechnungen erscheint eine Meldung von "Visual Basic " - "400". Bei Erstellung von 4 Rechnungen steht unter der Tabelle "Summe - €" Erst wenn ich 5 Rechnungen oder mehr erstellt habe ist alles OK.
Woran liegt das ?
Hans
Hier das Makro
Sub dateinameneinlesen1()
Dim strPfad As String, strDatnam As String
Dim neueZeile As Long, strTemp, i As Integer
'Erst der Pfad
strPfad = "C:\Recycling\Rechnungen\"
strDatnam = Dir(strPfad & "*.xlsm")
'ersteZeile für das Ergebnis
neueZeile = 6
'alte Daten löschen
Rows(neueZeile).CurrentRegion.Rows.Delete Shift:=xlUp
Do While Len(strDatnam)
'Dateinamen (ohne Endung und €-Zeichen) aufteilen, _
Trennzeichen ist " - "
strTemp = Split(Left(strDatnam, Len(strDatnam) - 6), " - ")
'Prüfen ob Datei mit angegebenen Datum übereinstimmt
If strTemp(1) = Format(Range("A1"), "dd.mm.yyyy") Then
'Daten eintragen:
For i = 0 To UBound(strTemp) - 1
Cells(neueZeile, i + 1) = strTemp(i)
Next
Cells(neueZeile, i + 1) = CCur(strTemp(i))
Cells(neueZeile, i + 1).Style = "Currency"
neueZeile = neueZeile + 1
End If
strDatnam = Dir
Loop
Cells(neueZeile, i) = "Summe"
Cells(neueZeile, i + 1).Style = "Currency"
Cells(neueZeile, i + 1).FormulaR1C1 = "=SUM(R[-" & neueZeile - 10 & "]C:R[-1]C)"
End Sub

19
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Fehler im Makro - Summe berechnen
15.12.2017 15:41:09
UweD
Hallo
beim Start ist neueZeile=6
bei 4 Rechnungen ist NeueZeile dann 11 (10+1)
in der Summenformel ziehst du immer 10 ab. Also wird der Wert erst ab 5 Rechnungen positiv
Summe(ab... muss fix sein
so in der Art 
StartZeile=6
neueZeile = Startzeile
neueZeile = neueZeile + 1
Cells(neueZeile, i + 1).FormulaR1C1 = "=SUM(R" & StartZeile &"C:R[-1]C)"

LG UweD
Fehlermeldung von Visual Basic
15.12.2017 16:05:59
Visual
Hallo Uwe,
vielen Dank für die Hilfe. Ich bekomme die Fehlermeldung "Microsoft Visual Basic" - "400" nachdem ich versucht habe das Makro nach deinen Angaben anzupassen.
Ich denke mal dass ich dabei einiges übersehen habe. Kannst du bitte so freundlich sein, das Makro mit deinen Änderungen zurück zu schicken ?
Ich setze immer das Original Makro und die geänderten Makros jeweils in ein Word Dokument und lasse mir dann beide Makros nebeneinander anzeigen, dann suche ich nach den Änderungen und markiere mir diese in rot. So sehe ich dann was und wo etwas geändert wurde.
Ich hoffe dadurch schneller auf meine Fehler zu kommen und besser lernen zu können
Vielen Dank
Hans
Anzeige
AW: Fehler anzeigen...
15.12.2017 18:24:08
robert
..in einem leeren Blatt ein Makro in Spalte A kopieren, das 2. Makro in Spalte B kopieren,
in C1:
=Wenn(A1B1;"Fehler";"") und runterkopieren.....
@Robert - Ich versehehe nur Bahnhof
15.12.2017 18:33:12
Hans
Moin moin Robert,
damit kann ich gar nichts anfangen !
Sorry
Hans
AW: @Robert - Ich versehehe nur Bahnhof
15.12.2017 18:43:49
robert
..das war eine Methode zur Fehlersuche(Code-Zeilen-Unterschied) von 2 Makros....
also ohne Word usw...
AW: @Robert - Ich habe verstanden, denke ich
15.12.2017 19:01:07
Hans
Hallo Robert...
nun hab ich es begriffen, du meinst also ohne den Vergleich über Word...
Danke für den Tipp, werde es gleich mal versuchen....
Meine Frage ist aber immer noch offen
Hans
Kann mir keiner das Makro anpassen?
15.12.2017 22:27:41
Hans
Hallo,
ich hab noch immer Probleme mit dem Makro.
Sub dateinameneinlesen1()
Dim strPfad As String, strDatnam As String
Dim neueZeile As Long, strTemp, i As Integer
'Erst der Pfad
strPfad = "C:\Recycling\Rechnungen\"
strDatnam = Dir(strPfad & "*.xlsm")
'ersteZeile für das Ergebnis
neueZeile = 6
'alte Daten löschen
Rows(neueZeile).CurrentRegion.Rows.Delete Shift:=xlUp
Do While Len(strDatnam)
'Dateinamen (ohne Endung und €-Zeichen) aufteilen, _
Trennzeichen ist " - "
strTemp = Split(Left(strDatnam, Len(strDatnam) - 6), " - ")
'Prüfen ob Datei mit angegebenen Datum übereinstimmt
If strTemp(1) = Format(Range("A1"), "dd.mm.yyyy") Then
'Daten eintragen:
For i = 0 To UBound(strTemp) - 1
Cells(neueZeile, i + 1) = strTemp(i)
Next
Cells(neueZeile, i + 1) = CCur(strTemp(i))
Cells(neueZeile, i + 1).Style = "Currency"
neueZeile = neueZeile + 1
End If
strDatnam = Dir
Loop
Cells(neueZeile, i) = "Summe"
Cells(neueZeile, i + 1).Style = "Currency"
Cells(neueZeile, i + 1).FormulaR1C1 = "=SUM(R[-" & neueZeile - 10 & "]C:R[-1]C)"
End Sub

UweD hat folgendes vorgeschlagen:
StartZeile=6
neueZeile = Startzeile
neueZeile = neueZeile + 1
Cells(neueZeile, i + 1).FormulaR1C1 = "=SUM(R" & StartZeile &"C:R[-1]C)"
Ich hab keinen Dunst wohin damit. Hab wirklich schon alles versucht, es geht einfach nicht!
Hans
Anzeige
AW: Kann mir keiner das Makro anpassen?
16.12.2017 08:10:04
Piet
Hallo Hans
ohne den ganzen Thread zu kennen gehe ich davon aus das der neue Code wie unten aussehen muss. s. Fettdruck
Unklar ist mir aber ob Cells(neueZeile, i) = "Summe" - vor oder hinter neueZeile gehört?
Das siehst du ja selbst am Ergebnis. Probier es einfach aus wo er hingehört!
mfg Piet
Cells(neueZeile, i) = "Summe"
Cells(neueZeile, i + 1).Style = "Currency"
Cells(neueZeile, i + 1).FormulaR1C1 = "=SUM(R[-" & neueZeile - 10 & "]C:R[-1]C)"
neuer Code: 
     neueZeile = Startzeile + 1
Cells(neueZeile, i + 1).Style = "Currency"
Cells(neueZeile, i + 1).FormulaR1C1 = "=SUM(R" & StartZeile &"C:R[-1]C)"

Anzeige
AW: Kann mir keiner das Makro anpassen?
16.12.2017 12:54:56
Firmus
Hallo Hans,
setze doch einmal anstelle deiner Zeile mit "....FormulaR1C1..." folgenden Block ein.
Dim tmpCol As String
Dim tmpC1 As String
Dim strtemp2 As Variant
tmpC1 = Cells(neueZeile, i + 1).Address
strtemp2 = Split(tmpC1, "$")
tmpCol = strtemp2(1)
tmpC1 = "=SUM(" & tmpCol & neueZeile - 10 & ":" & tmpCol & neueZeile - 1 & ")"
Cells(neueZeile, i + 1).Formula = tmpC1
Er ermöglicht dir sehr einfach das Testen der Werte die in deiner Summenformel stehen sollen.
Mit schrittweiser Ausführung solltest du deinen Fehler schnell entdecken.
Ausserdem finde ich, dass die Formula-Schreibweise viel leichter anzuwenden und transparenter ist.
Lass hören ob es klappt.
Solltest du immer noch Probleme haben, lade doch ein Muster hoch, damit man sieht wie das ganze aussehen soll.
Gruß
Firmus
Anzeige
@Firmus
16.12.2017 19:54:48
Hans
Hallo,
vielen Dank für deinen Code. Leider kann ich damit noch gar nichts anfangen. VBA sind noch sieben Siegel für mich.
Also, erst einmal den Code, den ich mir zusammengebastelt habe...
Sub dateinameneinlesen1()
Dim strPfad As String, strDatnam As String
Dim neueZeile As Long, strTemp, i As Integer
'Erst der Pfad
strPfad = "C:\Recycling\Rechnungen\"
strDatnam = Dir(strPfad & "*.xlsm")
'ersteZeile für das Ergebnis
neueZeile = 6
'alte Daten löschen
Rows(neueZeile).CurrentRegion.Rows.Delete Shift:=xlUp
Do While Len(strDatnam)
'Dateinamen (ohne Endung und €-Zeichen) aufteilen, _
Trennzeichen ist " - "
strTemp = Split(Left(strDatnam, Len(strDatnam) - 6), " - ")
'Prüfen ob Datei mit angegebenen Datum übereinstimmt
If strTemp(1) = Format(Range("A1"), "dd.mm.yyyy") Then
'Daten eintragen:
For i = 0 To UBound(strTemp) - 1
Cells(neueZeile, i + 1) = strTemp(i)
Next
Cells(neueZeile, i + 1) = CCur(strTemp(i))
Cells(neueZeile, i + 1).Style = "Currency"
neueZeile = neueZeile + 1
End If
strDatnam = Dir
Loop
Cells(neueZeile, i) = "Summe"
Cells(neueZeile, i + 1).Style = "Currency"
Cells(neueZeile, i + 1).FormulaR1C1 = "=SUM(R[-" & neueZeile - 10 & "]C:R[-1]C)"
End Sub
Dazu ein Bild von der Datei: Userbild
und noch die Datei...

Die Datei https://www.herber.de/bbs/user/118370.xlsm wurde aus Datenschutzgründen gelöscht


Das Problem dabei, es müssen mindestens 5 Rechnungen erstellt werden, damit am Ende der Tabelle eine Summe berechnet wird.....
Ich möchte aber schon bei einer Rechnung eine Summe angezeigt bekommen....
Ich hab schon den Tipp von UweD ausprobiert, komme aber mit den Zeilen und Anweisungen nicht klar.
Vielen Dank
Anzeige
Haken vergessen noch offen owT
16.12.2017 20:40:11
Hans
aa
AW: Haken vergessen noch offen owT
17.12.2017 13:41:37
Werner
Hallo Hans,
anscheinend geht es ja nur um die Summenbildung, von daher hat mich der Rest des Codes auch nicht angeschaut, da der ja wohl zufriedenstellend läuft.
Sehe ich das richtig, dass deine Spalten für die Quittungsnummer und für die Beträge immer die Spalten G und H sind? Versuch mal folgendes: 
Sub dateinameneinlesen1()
Dim strPfad As String, strDatnam As String
Dim neueZeile As Long, loLetzte As Long, strTemp, i As Integer
'Erst der Pfad
strPfad = "C:\Recycling\Rechnungen\"
strDatnam = Dir(strPfad & "*.xlsm")
'ersteZeile für das Ergebnis
neueZeile = 6
'alte Daten löschen
Rows(neueZeile).CurrentRegion.Rows.Delete Shift:=xlUp
Do While Len(strDatnam)
'Dateinamen (ohne Endung und €-Zeichen) aufteilen, _
Trennzeichen ist " - "
strTemp = Split(Left(strDatnam, Len(strDatnam) - 6), " - ")
'Prüfen ob Datei mit angegebenen Datum übereinstimmt
If strTemp(1) = Format(Range("A1"), "dd.mm.yyyy") Then
'Daten eintragen:
For i = 0 To UBound(strTemp) - 1
Cells(neueZeile, i + 1) = strTemp(i)
Next
Cells(neueZeile, i + 1) = CCur(strTemp(i))
Cells(neueZeile, i + 1).Style = "Currency"
neueZeile = neueZeile + 1
End If
strDatnam = Dir
Loop
loLetzte = Cells(Rows.Count, 7).End(xlUp).Row
Cells(loLetzte + 1, 8) = WorksheetFunction.Sum(Range(Cells(6, 8), Cells(loLetzte, 8)))
Cells(loLetzte + 1, 7) = "Summe"
End Sub
Gruß Werner
Anzeige
AW: Haken vergessen noch offen owT
17.12.2017 15:35:50
Hans
Hallo Werner
vielen lieben Dank, nun ist es fasst so wie ich wollte.
Hab es gerade mal ausprobiert was mit aufgefallen ist, manchmal zeigt es das Eurosymbol an, manchmal nicht.
5 Rechnungen € Symbol da; 15 Rechnung kein € Symbol.
Eine Lösung dafür und ich kann bis zum Ende des Jahres wieder ruhig schlafen.....
Schönen 3. Advent noch
Hans
PS: Manchmal fliegt der Haken, für Frage noch offen in der Vorschau raus. Liegt es am MS Edge ?
@werner
17.12.2017 15:39:14
Hans
Hups...
ich meinte nur das Eurosymbol in der "Summe"
Danke
Hans
AW: @werner
17.12.2017 15:52:22
Werner
Hallo Hans,
Sub dateinameneinlesen1()
Dim strPfad As String, strDatnam As String
Dim neueZeile As Long, loLetzte As Long, strTemp, i As Integer
'Erst der Pfad
strPfad = "C:\Recycling\Rechnungen\"
strDatnam = Dir(strPfad & "*.xlsm")
'ersteZeile für das Ergebnis
neueZeile = 6
'alte Daten löschen
Rows(neueZeile).CurrentRegion.Rows.Delete Shift:=xlUp
Do While Len(strDatnam)
'Dateinamen (ohne Endung und €-Zeichen) aufteilen, _
Trennzeichen ist " - "
strTemp = Split(Left(strDatnam, Len(strDatnam) - 6), " - ")
'Prüfen ob Datei mit angegebenen Datum übereinstimmt
If strTemp(1) = Format(Range("A1"), "dd.mm.yyyy") Then
'Daten eintragen:
For i = 0 To UBound(strTemp) - 1
Cells(neueZeile, i + 1) = strTemp(i)
Next
Cells(neueZeile, i + 1) = CCur(strTemp(i))
Cells(neueZeile, i + 1).Style = "Currency"
neueZeile = neueZeile + 1
End If
strDatnam = Dir
Loop
loLetzte = Cells(Rows.Count, 7).End(xlUp).Row
Cells(loLetzte + 1, 8) = WorksheetFunction.Sum(Range(Cells(6, 8), Cells(loLetzte, 8)))
Cells(loLetzte + 1, 8).NumberFormat = "#,##0.00 $"
Cells(loLetzte + 1, 7) = "Summe"
End Sub
Gruß Werner
Anzeige
AW: Haken vergessen noch offen owT
17.12.2017 15:49:52
firmus
Hallo Hans,
anbei die vermutete Lösung: https://www.herber.de/bbs/user/118380.xlsm
Ich habe mir mal "zusammengereimt" was du erreichen willst.
1. In deinem Verzeichnis stehen 1 - n Dateien
2. die Dateinamen sehen in etwa SO aus: "x1 - 17.12.2017 - partikel1 - p2 - p3 - p4 - p5 - 25,30.xlsm"
3. Falls das Datum der Dateinamen (part.2) gleich deiner Datumsvorgabe ist, soll die Datei ausgewählt werden.
4. Für jeden ausgewählten Dateinamen ist eine Zeile im XLS-Blatt zu erzeugen.
5. Der Dateiname ist zu zerlegen und in den einzelnen Spalten abzulegen.
6. Der vorletzte Partikel beinhaltet den Preis. Der Preis wird in der Spalte "Betrag" eingetragen.
7. Nach jeder Zeile soll eine Summe gebildet werden.
Fragen:
1. Wie soll die Summenbildung aussehen.
a) Summe nach jeder Zeile: Soll jeweils die Summe aller bisherigen Zeilen gebildet werden?
(So ist es derzeit programmiert)
b) anderes Kriterium:
1) Soll pro Kunde (für den ausgewählten Tag) eine Summe gebildet werden?
(hierzu müssten die ankommenden Dateinamen nach Kunde sortiert sein.)
2) Soll am Ende eine Gesamtsumme (dieses Tages) gebildet werden?
Schau es dir an, lass "hören" ob und wie es passt.
Gruß
Firmus
Anzeige
@Firmus
17.12.2017 16:05:22
Hans
Hallo firmus,
Werner lieferte mir schon das richtige Ergebnis..
Am untersten Ende der Tabelle eine Summe des Gesamtergebnis (aller Tagesrechnungen)
Nun hab ich nur noch das Problem, dass in der Summe mal das Eurosymbol € angezeigt wird, mal nicht....
Übrigens: oftmals verschwindet der Haken "Beitrag noch offen" nach der Vorschau liegt das an Edge ?
G E L Ö S T
17.12.2017 16:11:24
Hans
Hallo Forum,
vielen Dank an alle Helfer, besonders an Werner, der die Lösung brachte. (freu)
Hier noch einmal das komplette Makro:
(Nun kann ich wieder ruhig schlafen! LOL)
Sub dateinameneinlesen1()
Dim strPfad As String, strDatnam As String
Dim neueZeile As Long, loLetzte As Long, strTemp, i As Integer
'Erst der Pfad
strPfad = "C:\Recycling\Rechnungen\"
strDatnam = Dir(strPfad & "*.xlsm")
'ersteZeile für das Ergebnis
neueZeile = 6
'alte Daten löschen
Rows(neueZeile).CurrentRegion.Rows.Delete Shift:=xlUp
Do While Len(strDatnam)
'Dateinamen (ohne Endung und €-Zeichen) aufteilen, _
Trennzeichen ist " - "
strTemp = Split(Left(strDatnam, Len(strDatnam) - 6), " - ")
'Prüfen ob Datei mit angegebenen Datum übereinstimmt
If strTemp(1) = Format(Range("A1"), "dd.mm.yyyy") Then
'Daten eintragen:
For i = 0 To UBound(strTemp) - 1
Cells(neueZeile, i + 1) = strTemp(i)
Next
Cells(neueZeile, i + 1) = CCur(strTemp(i))
Cells(neueZeile, i + 1).Style = "Currency"
neueZeile = neueZeile + 1
End If
strDatnam = Dir
Loop
loLetzte = Cells(Rows.Count, 7).End(xlUp).Row
Cells(loLetzte + 1, 8) = WorksheetFunction.Sum(Range(Cells(6, 8), Cells(loLetzte, 8)))
Cells(loLetzte + 1, 8).NumberFormat = "#,##0.00 $"
Cells(loLetzte + 1, 7) = "Summe"
End Sub

Anzeige
Gerne u. Danke für die Rückmeldung. o.w.T.
17.12.2017 16:19:45
Werner

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige