Import aus Textdatei

[sunny01]

Hallo,

ich hätte folgende Aufgabe und würde eine kompakte VBA Lösung dafür suchen:

1. Code für den Import des Inhalts einer Textdatei in Register 1 einer Excel Datei, wobei die zeilenweise Eingaben in der Textdatei ebenfalls zeilenweise in Excel übernommen werden sollten. Eine Beispieldatei zum Import habe ich beigelegt.
2. Code für die Aufteilung der zeilenweisen Einträge in Register 1 in mehrere Spalten in Register 2, wobei die Einträge nach folgenden 4 Zeichen in der jeweiligen Zeile voneinander getrennt und jeweils in eine neue Spalte (in derselben Zeile) geschrieben werden sollten:  =  (  )  ,


Vielen Dank für Eure Unterstützung!

[sunny01]

Hallo,

ich hätte folgende Aufgabe und würde eine kompakte VBA Lösung dafür suchen:

1. Code für den Import des Inhalts einer Textdatei in Register 1 einer Excel Datei, wobei die zeilenweise Eingaben in der Textdatei ebenfalls zeilenweise in Excel übernommen werden sollten. Eine Beispieldatei zum Import habe ich beigelegt.
2. Code für die Aufteilung der zeilenweisen Einträge in Register 1 in mehrere Spalten in Register 2, wobei die Einträge nach folgenden 4 Zeichen in der jeweiligen Zeile voneinander getrennt und jeweils in eine neue Spalte (in derselben Zeile) geschrieben werden sollten:  =  (  )  ,


Vielen Dank für Eure Unterstützung!

[kkr4]

Dafür gibt es inzwischen Power Query innerhalb von Excel!

[volti]

Hallo,

hier noch eine Idee mit klassischen VBA-Mitteln.
Kannst Du ja mal testen...

Code:

Option Explicit

Sub ImportTest()
  Dim sFilename As String
  Dim sArr() As String, sArr2() As String
  Dim iFF As Integer, i As Long

  sFilename = "C:\Users\voltm\Desktop\Import.txt"
  iFF = FreeFile
  If Dir(sFilename) <> "" Then                               'Ist Datei vorhanden?
     Open sFilename For Input As iFF                         'Datei öffnen
     sArr = Split(Input(LOF(iFF), iFF), vbCrLf)              'Daten in Array einlesen
     Close iFF                                               'Datei schließen

' Datenausgabe
     Sheets("Tabelle1").Range("A1").Resize(UBound(sArr) + 1, 1) = Application.Transpose(sArr)

' Daten aufteilen
     For i = 0 To UBound(sArr) - 1
       sArr(i) = Replace(sArr(i), "=", ",")
       sArr(i) = Replace(Replace(sArr(i), "((", ","), "))", ",")
       sArr(i) = Replace(Replace(sArr(i), "(", ","), ")", ",")
       sArr(i) = Replace(sArr(i), ",;", "")
       sArr2 = Split(sArr(i) & ",", ",")
       Sheets("Tabelle2").Cells(i + 1, "A").Resize(1, UBound(sArr2)) = sArr2
     Next i
  
  End If

End Sub

_________
viele Grüße
Karl-Heinz

[sunny01]

Hallo Karl-Heinz,

vielen Dank für die gute Lösung! Könntest Du mir in diesen Code noch den Aufruf eines Dialogfensters einbauen, dass ich darin die jeweilige Datei zum Einlesen der Daten angeben kann. Leider ergibt der Versuch der Anpassung Deines Codes dafür bei mir jedes Mal eine Fehlermeldung.

Vielen Dank!

[volti]

So vielleicht.....

Code:

Option Explicit

Sub ImportTest()
  Dim vFilename As Variant
  Dim sArr() As String, sArr2() As String
  Dim iFF As Integer, i As Long
  
  vFilename = Application.GetOpenFileName("Text-Dateien (*.txt), *.txt")
  If vFilename = False Then Exit Sub

  Application.ScreenUpdating = False
  
  iFF = FreeFile
  If Dir(vFilename) <> "" Then                               'Ist Datei vorhanden?
     Open vFilename For Input As iFF                         'Datei öffnen
     sArr = Split(Input(LOF(iFF), iFF), vbCrLf)              'Daten in Array einlesen
     Close iFF                                               'Datei schließen

' Datenausgabe
     Sheets("Tabelle1").Range("A1").Resize(UBound(sArr) + 1, 1) = Application.Transpose(sArr)

' Daten aufteilen
     For i = 0 To UBound(sArr) - 1
       sArr(i) = Replace(sArr(i), "=", ",")
       sArr(i) = Replace(Replace(sArr(i), "((", ","), "))", ",")
       sArr(i) = Replace(Replace(sArr(i), "(", ","), ")", ",")
       sArr(i) = Replace(sArr(i), ",;", "")
       sArr2 = Split(sArr(i) & ",", ",")
       Sheets("Tabelle2").Cells(i + 1, "A").Resize(1, UBound(sArr2)) = sArr2
     Next i
  
  End If
  Application.ScreenUpdating = True
  
End Sub

_________
viele Grüße
Karl-Heinz

[sunny01]

Hallo Karl-Heinz,

vielen Dank für die optimale Lösung!