Hallo zusammen,
ich bin VBA "Neuling mit etwas Kontakt".
Folgendes Projekt möchte ich realisieren. Es soll eine Auswertungstabelle werden, jedoch brauch er dazu 3 CSV-Dateien.In jeder CSV stehen 3 Werte mit einer Überschrift. in der Zweiten Zeile beginnen die benötigten Informationen. Diese CSV Dateien können beliebig heißen und an jedem Speicherort liegen. D.h. das der User den Pfad selbst angeben muss, wo diese Datei liegt (Browser Suchfunktion), die er importieren möchte. Per Mausklick soll er jedoch angeben, was das für eine Datei ist (Dafür das Frame-Auswahlfenster).
Diese Datei soll dann in die jeweilige Tabelle und in das richtige Tabellenblatt eingefügt werden (variable an die nächste freie Zeile)
Nun kommt der Haken: Der User muss angeben, von wann die CSV-Datei ist. Das Datum soll per klick bestätigt werden und in die bereits importierte Datei in die Spalte 4 ein der nächsten freien Zeile eingefügt werden - anschließend soll das Programm prüfen, ob sich in Spalte 3 ein Eintrag befindet, wenn dem so ist, soll das eingegebene Datum dupliziert werden, und zwar so lange, bis er in der Spalte 3, in der nächsten Zeile keinen Eintrag mehr findet.
Zur Veranschaulichung habe ich ein par Bilder angefügt.
Sub Datei_Importieren()
Dim strFileName As String, arrDaten, arrTmp, lngR As Long, lngLast As Long
Const cstrDelim As String = ";" 'Trennzeichen
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
.Title = "Datei wählen"
.InitialFileName = "c:\test\" 'Pfad anpassen
.Filters.Add "CSV-Dateien", "*.csv", 1
.Filters.Add "Alle Dateien", "*.*", 2
If .Show = -1 Then
strFileName = .SelectedItems(1)
End If
End With
If strFileName <> "" Then
Application.ScreenUpdating = False
Open strFileName For Input As #1
arrDaten = Split(Input(LOF(1), 1), vbCrLf)
Close #1
For lngR = 1 To UBound(arrDaten)
arrTmp = Split(arrDaten(lngR), cstrDelim)
If UBound(arrTmp) > -1 Then
With ActiveSheet
lngLast = .Cells(Rows.Count, 1).End(xlUp).Row + 1
lngLast = Application.Max(lngLast, 1)
.Cells(lngLast, 1).Resize(, UBound(arrTmp) + 1) _
= Application.Transpose(Application.Transpose(arrTmp))
.Cells(lngLast, 11) = Mid(strFileName, InStrRev(strFileName, "\") + 1)
End With
'last = ActiveSheet.Cells(Rows.Count, 4).End(xlUp).Row + 1
End If
Next lngR
End If
'Sheets(1).Range("A1")=strFileName 'Dateiname in Blatt1!A1
End Sub
Kann mir da jemand weiter helfen? Ich habe schon so viel ausprobiert und bin gerade richtig froh, das der Daten import funktioniert. Vielen Dank im voraus :-)
