Schleife um variable Werte zu befüllen
24.04.2018 20:08:12
PurgerKiko
ich nutze VBA im Geschäft aber würde mich als Amateur bezeichnen.
Nun würde ich gern im privaten Bereich etwas programmieren was ich nicht hinbekomme.
Ich habe eine Excel-Datei in der ich die Spalte D markiere und einen bestimmten Text suche "Kartenzahlung" (dieser kommt öfters vor in der Spalte D). Wenn der Code den Text findet, soll er sich in Spalte C den Zellinhalt merken und in Spalte F und H genauso.
Dann soll er den nächsten Wert "Kartenzahlung" suchen und wieder das gleiche merken.
Ich habe dafür die Variablen "Valutadatum()", "Begünstigter()" und "Betrag() deklariert.
Nun hänge ich an der Schleife und bekomme sie einfach nicht hin.
Ihr bekommt das bestimmt hin....vlt. hat jemand Lust mir nen Codeabschnitt zu schicken der mir weiterhilft.
Mein Code bis zur Schleife sieht so aus:
Option Explicit
Sub KontoauszugBefüllung()
Dim DDMMYYYY As Date
Dim TagDD As Variant
Dim MonatDD As Variant
Dim JahrDD As Variant
Dim DateiDatum As Variant
Dim Answer As Variant
Dim DateiNameKontoauszug As Variant
Dim dateiname As String
Dim filename As Variant
Dim x As Variant
Dim i As Integer
Dim iRow As Integer: iRow = 1
Dim ValutaDatum() As Date
Dim Begünstigter() As String
Dim Betrag() As Double
Dim Zelle As Variant
Dim lngR As Variant
Dim wb As Workbook
Dim pfad As String, dateien
Dim datei
Dim strPath As String, strFileName As String
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'Über den heutigen Tag die Bearbeitung starten ' _
XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
DDMMYYYY = Format(DateSerial(Year(Now()), Month(Now()), 1), "DD.MM.YYYY")
TagDD = Mid(DDMMYYYY, 1, 2)
MonatDD = Mid(DDMMYYYY, 4, 2)
JahrDD = Mid(DDMMYYYY, 7, 4)
MonatDD = MonatDD - 1
Select Case MonatDD
Case 1: MonatDD = "01"
Case 2: MonatDD = "02"
Case 3: MonatDD = "03"
Case 4: MonatDD = "04"
Case 5: MonatDD = "05"
Case 6: MonatDD = "06"
Case 7: MonatDD = "07"
Case 8: MonatDD = "08"
Case 9: MonatDD = "09"
End Select
DateiDatum = MonatDD & "." & JahrDD
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'Umwandlung einer csv Datei in eine xlsx Datei ' _
XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'pfad = "H:\privat\Privatno\VBA-privat\" ' auf \ am Ende achten 'dateien = Array(DateiDatum & "- _
_
7800832") ' Dateinamen ohne Endung 'Application.ScreenUpdating = False
' For Each datei In dateien
' Set wb = Workbooks.Open(pfad & datei & ".csv", local:=True)
' wb.SaveAs pfad & datei & ".xlsx", FileFormat:=xlOpenXMLWorkbook
' wb.Close
' Next
' Set wb = Nothing
' Application.ScreenUpdating = True
''Die umgewandelte CSV.Datei wird nicht mehr benötigt und wird deshalb gelöscht 'Kill "H:\ _
privat\Privatno\VBA-privat\" & DateiDatum & "-XXXXX" & ".csv"
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'Öffnen der Datei in xlsx
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
Nochmal:
'Öffnen der Datei mit möglicher Fehlerbearbeitung DateiNameKontoauszug = DateiDatum & "-XXXX. _
xlsx"
dateiname = "H:\privat\Privatno\VBA-privat\" & DateiNameKontoauszug If Dir(dateiname, vbNormal) _
_
= "" Then
MsgBox "Der Kalender wurde nicht gefunden.", vbCritical, "Information"
Answer = MsgBox("Wurde Problem behoben?", vbQuestion + vbYesNo,
"Information")
If Answer = vbYes Then
GoTo Nochmal
End If
If Answer = vbNo Then
MsgBox "Bearbeitung wird abgebrochen"
Exit Sub
End If
Else
Workbooks.Open filename:=(dateiname)
filename = ActiveWorkbook.Name
End If
x = Application.WorksheetFunction.CountIf(Range("D:D"), "KARTENZAHLUNG")
'Suche nach Werten
Range("D:D").Select
For Each Zelle In Selection
If Zelle = "KARTENZAHLUNG" Then
Zelle.Select
lngR = ActiveCell.Row + 1
Zelle.Offset(0, -1).Select
ValutaDatum(x) = ActiveCell
Begünstigter(x) = Zelle.Offset(0, 2).Value
Betrag(x) = Zelle.Offset(0, 5).Value
Exit For
End If
Next
End Sub
Vielen Dank schonmal.
PurgerKiko