Bei Signalwörtern Zeile ausschneiden und einfügen

[joshua]

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

[Steffl]

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

[joshua]

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

Beste Grüße
Joshua

[Steffl]

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?

[joshua]

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

[Steffl]

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.

[joshua]

Nope, funktioniert leider nicht.

Wie gewünscht, anbei einmal eine Musterdatei


PS.: Jap, Stanislawski hat im hamburger Norder ein Rewe (Franchise) (:

[Steffl]

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?

[joshua]

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) (:

[Steffl]

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