Liebes Forum,
nachdem ich jetzt 2 Tage rumgebastelt und verschiedene Codes aus dem Internet ausprobiert habe, hoffe ich auf jemanden, der mir hier weiterhelfen kann.
Ich möchte eine Textdatei in Excel einlesen, die mit Semikolons getrennt ist.
Diese soll auf die verschiedenen Spalten aufgeteilt werden.
Die Textdatei möchte ich im Explorer selber auswählen können.
Anbei zwei Codes die auf Ihre Art wunderbar funktionieren, aber ich bräuchte eine Kombination aus beiden. Es ist mir nicht gelungen selber etwas zu basteln, weil mir dazu das Wissen fehlt.
CODE 1
Dieser Code funktioniert in der Umsetzung super. Er trennt alles sauber. Leider kann ich die zu importierende Text-Datei nicht selber aussuchen. Sie muss in dem Ordner vorhanden sein, wo sich auch diese Arbeitsmappe befindet. In Zelle G1 müsste ich den Dateinamen eintragen, damit die .txt-Datei geöffnet und importiert werden kann.
Mit der Datei sollen auch Excelferne Personen arbeiten können.
Private Sub CommandButton3_Click()
Dim Pfad As String, lfnNr As Integer, Zeile As String, Inhalt() As String
Dim Ziel As Range
Dim str_ordner As String 'verzeichnis
Dim str_file As String 'dateiname
Dim str_cache As String 'cache
Dim zaehler As Integer 'zaehler
Dim zaehlerende As Integer 'Zaehler ende
Sheets("Test2").Activate
str_cache = Range("G1") '.Text & str_file
'Freie Zelle in Spalte A suchen
Sheets("Test2").Activate
With ThisWorkbook.ActiveSheet
Set Ziel = .Range("A65536").End(xlUp).Offset(1, 0)
If IsEmpty(.Range("A3")) Then Set Ziel = .Range("A3")
End With
'Variablen füllen
Pfad = str_cache
lfnNr = FreeFile
'Prüfen, ob Pfad exisistiert
If Dir(Pfad) = "" Then
MsgBox "Datei nicht vorhanden" & Pfad, , "Meldung"
Exit Sub
End If
'Datei öffnen
Open Pfad For Input As #lfnNr
'Weitermachen bis alle Zeilen abgearbeitet
Do While Not EOF(lfnNr)
'Zeile einlesen
Line Input #lfnNr, Zeile
'Wenn Zeile Leer dann mache nichts
If Trim(Zeile) <> "" Then
'Wenn Zeile ein ; enthält weitermachen
If InStr(Zeile, ";") > 0 Then
'Zeile in mehrere Felder auftrennen, Trennzeichen ;
Inhalt = Split(Zeile, ";")
'Übertragen der Felder in freie Zeile
Ziel.Resize(1, UBound(Inhalt)).Value = Inhalt
Else
'Einzelnes Feld übertragen
Ziel.Value = Zeile
End If
'Nächste Zeile auswählen
Set Ziel = Ziel.Offset(1, 0)
End If
Loop
'Datei schließen
Close #lfnNr
'Aufräumen
Set Ziel = Nothing
zaehler = zaehler + 1
End Sub
CODE 2Mit diesem Code kann ich die Text-Datei selber auswählen. Leider wird die nur Zeilenweise importiert und nicht in die unterschiedlichen Spalten unterteilt.
Private Sub CommandButton1_Click()
Dim Quelle As Object, Ziel As Object
Dim Datei As String
On Error GoTo Fehler
'Dialog "Datei öffnen" anzeigen
'Datei = Application.GetOpenFilename("Excel-Dateien(*.xls),*xls")
Datei = Application.GetOpenFilename("Excel-Dateien(*.txt),*cvs")
'Abbrechen falls keine Datei ausgewählt
If Datei = "Falsch" Then
MsgBox "keine Datei ausgewählt", , "Abbruch"
Exit Sub
End If
'MsgBox "Ausgewählte Datei: " & Datei, , ""
'Ausgewählte Datei öffnen
Workbooks.Open Filename:=Datei
Set Quelle = ActiveWorkbook.Worksheets(1)
Set Ziel = ThisWorkbook.Worksheets(1)
'kopieren und einfügen
Quelle.UsedRange.Copy Ziel.Cells(3, 1)
ActiveWorkbook.Close
'Speicher freigeben
Set Quelle = Nothing
Set Ziel = Nothing
Exit Sub
Fehler:
Set Quelle = Nothing
Set Ziel = Nothing
MsgBox "FehlerNr.: " & Err.Number & vbNewLine & vbNewLine _
& "Beschreibung: " & Err.Description _
, vbCritical, "Fehler"
End Sub
Wie gesagt, möchte ich eine Kombination aus beiden Codes. Von mir aus auch gekürzt. Also ohne Meldung, dass die Datei nicht gefunden wurde. Das fällt eh weg, wenn man sie selber aussuchen kann.
Vielen Dank im Voraus für Eure Denkarbeit.
Liebe Grüße
Anja