Sehr geehrte Community!
Ich bin gerade dabei ein Haushaltsbuch individuell an meine Wünsche und Gegebenheiten zu erstellen.
Um den nötigen Input zu erhalten, benutze ich die Export-Funktion meines Bankinstitutes mittels CSV-Datei.
Leider enthält diese Datei arg viele Daten, welche nun strukturiert sortiert werden müssen.
Einmal würde ich gerne alle Zeilen, welche in Spalte E kein "-" vor dem Betrag erhalten, in die Tabelle "Einnahmen" geschoben werden (Cut/paste)
Dann würde ich gerne alle Zeilen, welche "LIDL" oder "REWE" in Spalte D enthalten, nach Tabelle "Lebenshaltung" einfüge (Cut/paste).
Gerne würde ich dies mal wieder mit VBA lösen.
Kann mir einer von euch mal wieder behilflich sein?
Beste Grüße
Joshua
Hallo Joshua,
mal ein erster ausbaufähiger Ansatz
Code:
Sub prcJoshua()
Dim lngC As Long, lngLastRow As Long, lngAufnahme As Long
With Worksheets("Tabelle1") 'bitte anpassen!
lngLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
For lngC = 2 To lngLastRow
If .Cells(lngC, 5) > 0 Then
With Worksheets("Einnahmen")
lngAufnahme = .Cells(Rows.Count, 1).End(xlUp).Row + 1
End With
.Rows(lngC).Cut Worksheets("Einnahmen").Cells(lngAufnahme, 1)
End If
Next lngC
End With
With Worksheets("Tabelle1") 'bitte anpassen!
lngLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
For lngC = 2 To lngLastRow
Select Case .Cells(lngC, 4)
Case "LIDL", "REWE"
With Worksheets("Lebenshaltung")
lngAufnahme = .Cells(Rows.Count, 1).End(xlUp).Row + 1
End With
.Rows(lngC).Cut Worksheets("Lebenshaltung").Cells(lngAufnahme, 1)
End Select
Next lngC
End With
End Sub
Hallo Stefan!
Vielen Dank für Deine Lösung.
Der erste Part funktioniert wunderbar.
Beim zweiten Part hackt es noch. Hier werden keine Zellen bearbeitet.
Die Zellen, welche das Signalwort "LIDL" oder "REWE" enthalten, haben folgende Struktur:
Auftraggeber: DANKE, IHR LIDL Buchungstext: Kartenzahlung DANKE, IHR LIDLXXXXXXXXXXXX
Auftraggeber: REWE Stanislawski Buchungstext: Kartenzahlung REWE SAGT DANKE. XXXXXXXXXXXXX
Muss Dein Code bzw. Case erweitert/ spezifiziert werden?
Code:
With Worksheets("tblUmsaetze") 'bitte anpassen!
lngLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
For lngC = 2 To lngLastRow
Select Case .Cells(lngC, 4)
Case "DANKE, IHR LIDL", "REWE"
With Worksheets("tblLebenshaltung")
lngAufnahme = .Cells(Rows.Count, 1).End(xlUp).Row + 1
End With
.Rows(lngC).Cut Worksheets("tblLebenshaltung").Cells(lngAufnahme, 1)
End Select
Next lngC
End With
Hallo Joshua,
versuche es mal so
Code:
Sub prcJoshua()
Dim rngTreffer As Range
Dim vntSuche As Variant
vntSuche = Array("LIDL", "REWE")
With Worksheets("tblUmsaetze") 'bitte anpassen!
For lngC = 0 To UBound(vntSuche)
Set rngTreffer = .Columns(4).Find(vntSuche(lngC), LookIn:=xlValues, lookat:=xlPart)
If Not rngTreffer Is Nothing Then
Do
With Worksheets("tblLebenshaltung")
lngAufnahme = .Cells(Rows.Count, 1).End(xlUp).Row + 1
End With
.Rows(rngTreffer.Row).Cut Worksheets("tblLebenshaltung").Cells(lngAufnahme, 1)
Set rngTreffer = .Columns(4).FindNext(rngTreffer)
Loop While Not rngTreffer Is Nothing
End If
Next lngC
End With
End Sub
Gruß Stefan
PS: "Stanislawski" Der Holger Stanislawski? Der ehemalige Trainer?
Hallo Stefan
vielen Dank für deine Lösung.
Es funktioniert nun super. Ich konnte den Code ganz problemlos an die anderen Tabellen anpassen.
Bzgl. dem ersten part hätte ich noch ein Anliegen.
Wenn in Spalte 5 >0 ist, so soll er die Zeile in Tabelle 2 kopieren.
Ich möchte nun aber dies nur, wenn in Spalte 5 eine Zahl ist. Bei Text soll dies nicht passieren.
Mit folgendem Ansatz komme ich leider nicht weiter:
Code:
If .Cells(lngC, 5) > 0 And IsNumeric(.Cells(lngC, 5)) Then
Hallo Joshua,
mal ungetestet
Code:
If .Cells(lngC, 5) > 0 And IsNumeric(Val(.Cells(lngC, 5))) Then
wenn es nicht funktioniert, sollte Du vielleicht mal die Datei hochladen, das man es selber testen kann.
Nope, funktioniert leider nicht.
Wie gewünscht, anbei einmal eine Musterdatei
PS.: Jap, Stanislawski hat im hamburger Norder ein Rewe (Franchise) (:
Hallo Joshua,
da sind ja zwei unterschiedliche Arten von Daten. Einmal Bank das andere Mal Kreditkarten und da stehen die Beträge in einer anderen Spalte. Sollen die auch übertragen werden?
Stimmt, anstatt mit Isnumeric zu arbeiten könnte man auch einfach die Schleife bis zu Kreditkarte ablaufen lassen.
Wie kann ich dann den ersten part von deinem Code nur bis dahin ablaufen lassen?
PS.: Jap, Stanislawski hat im hamburger Norder ein Rewe (Franchise) (:
Hallo Joshua,
für den ersten Part (Bank)
Code:
With Worksheets("Tabelle1") 'bitte anpassen!
lngC = 2
Do While .Cells(lngC, 1) <> ""
If .Cells(lngC, 5) > 0 Then
With Worksheets("Einnahmen")
lngAufnahme = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
End With
.Rows(lngC).Cut Worksheets("Einnahmen").Cells(lngAufnahme, 1)
End If
lngC = lngC + 1
Loop
End With