Makro zum automatischen Daten einlesen

[Dieter63]

Hallo,

Wer lesen kann ist klar im Vorteil -> Wo hab ich gesagt du sollst die externe Datei öffnen

Du öffnest ein leeres Excel -> Daten ..

[00202]

Hallo, :19:

hier mal eine VBA-Lösung: :21:

Code:

Option Explicit
Public Sub Main()
    Dim varArrQ As Variant
    Dim varArrZ As Variant
    Dim lngRow As Long
    On Error GoTo Fin
    Application.ScreenUpdating = False
    varArrQ = Split(fncRF("C:\Temp\Beispiel.txt"), vbCrLf) ' Pfad- Dateiname ggf. anpassen!!!
    ' Tabelle1 - Codename der Tabelle - Name VOR der Klammer im VBA-Editor
    Tabelle1.Range("A1:A" & UBound(varArrQ) + 1).Value = Application.Transpose(varArrQ)
    Tabelle1.UsedRange.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
Fin:
    Application.ScreenUpdating = True
    If Err.Number <> 0 Then MsgBox "Error: " & _
        Err.Number & " " & Err.Description
End Sub
Private Function fncRF(ByVal strDatei As String) As String
    Dim strInhalt As String
    Dim intTMP As Integer
    If Dir$(strDatei, vbNormal) <> "" Then
        intTMP = FreeFile
        Open strDatei For Binary As #intTMP
        strInhalt = Space$(LOF(intTMP))
        Get #intTMP, , strInhalt
        Close #intTMP
    End If
    fncRF = strInhalt
End Function

Zum Thema CodeName des Tabellenblattes: :21:

Klick mal hier...

[Sandrof90]

Hallo, :19:

hier mal eine VBA-Lösung: :21:

Hey Super Vielen Dank!

Eine Frage noch, Die Beispiel-Datei, die ich hochgeladen hatte ist deutlich kleiner als die Originaldatei. Wenn ich versuche meine Originaldatei damit zu bearbeiten (>800k Zeilen), dann bekomme ich die Fehlermeldung "13 Typen unverträglich" 

[00202]

Hallo, :19:

da dürfte die "Transpose-Methode" an ihre Grenzen stoßen. Probiere es mal so: :21:

Code:

Option Explicit
Public Sub Main()
    Dim varArrQ As Variant
    Dim varArrZ As Variant
    Dim lngRow As Long
    On Error GoTo Fin
    Application.ScreenUpdating = False
    varArrQ = Split(fncRF("C:\Temp\Beispiel.txt"), vbCrLf) ' Pfad- Dateiname ggf. anpassen!!!
    ' Tabelle1 - Codename der Tabelle - Name VOR der Klammer im VBA-Editor
    ReDim varArrZ(UBound(varArrQ), 1 To 1)
    For lngRow = LBound(varArrQ) To UBound(varArrQ)
        varArrZ(lngRow, 1) = varArrQ(lngRow)
    Next lngRow
    Tabelle1.Range("A1:A" & UBound(varArrZ) + 1).Value = varArrZ 'Application.Transpose(varArrQ)
    Tabelle1.UsedRange.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
Fin:
    Application.ScreenUpdating = True
    If Err.Number <> 0 Then MsgBox "Error: " & _
        Err.Number & " " & Err.Description
End Sub
Private Function fncRF(ByVal strDatei As String) As String
    Dim strInhalt As String
    Dim intTMP As Integer
    If Dir$(strDatei, vbNormal) <> "" Then
        intTMP = FreeFile
        Open strDatei For Binary As #intTMP
        strInhalt = Space$(LOF(intTMP))
        Get #intTMP, , strInhalt
        Close #intTMP
    End If
    fncRF = strInhalt
End Function

Wenn das auch nicht geht, Originaldatei her - am offenen Herzen lässt sich immer leichter operieren.

[Sandrof90]

da dürfte die "Transpose-Methode" an ihre Grenzen stoßen. Probiere es mal so: :21:

Damit läuft es! :18: Tausend Dank

Beste Grüße
Sandro

[00202]