Einlesen bestimmter Zeilen einer Textdatei

[ws-53]

Anbei die neue Version, die aus der einen .txt BGW, LCL und LCR extrahiert und in die Ergebnisse in die 3 Bereiche ausgibt.

Der Änderungsaufwand war recht überschaubar, da sich die Änderungen einfach zusammenklicken ließen.

[Egon12]

Hallo Tobias,
 
das anzupassen ist eigentlich kein Problem. Es muss lediglich ein optionaler Parameter hinzugefügt werden um die unterschiedlichen Strukturen zu verarbeiten.
Auch wenn da schon eine Anpassung von Ws-53 per PQ dir vorgeschlagen wurde, hänge ich meine Änderung der Prozedur nebst Aufrufe mit ran.

Code:

Option Explicit

Sub BGW_LCL_LCR()
    Call Eintragen(pfadTxt:=ThisWorkbook.Path & "\12345678901_10BG10LCL10LCR - Kopie.txt", Blatt:=Foglio3, Zelle:="D15,D40,D65", Struktur:="BGW,LCL,LCR")
End Sub

Sub Wash()
    Call Eintragen(pfadTxt:=ThisWorkbook.Path & "\10BGW.txt", Blatt:=Foglio3, Zelle:="D15")
End Sub

Sub LCL()
    Call Eintragen(pfadTxt:=ThisWorkbook.Path & "\10LCL.txt", Blatt:=Foglio3, Zelle:="D40")
End Sub

Sub Eintragen(ByVal pfadTxt As String, Blatt As Worksheet, Zelle As String, Optional Struktur As String)
    Dim arr, tmp, i&, j&, k&, Zellen
    arr = Filter(Split(CreateObject("scripting.filesystemobject").opentextfile(pfadTxt).readall, vbCrLf), "RLU")
    If Len(Struktur) = 0 Then
        ReDim arrList(1 To UBound(arr) + 1, 1 To 10)
        For i = LBound(arrList) To UBound(arrList)
            tmp = Split(Replace(arr(i - 1), " ", ""), vbTab)
            For j = LBound(arrList, 2) To UBound(arrList, 2)
                arrList(i, j) = CDbl(tmp(j))
            Next j
        Next i
        Blatt.Range(Zelle).Resize(UBound(arrList, 1), UBound(arrList, 2)) = arrList
    Else
        Zellen = Split(Zelle, ",")
        ReDim arrList(1 To 10, 1 To 10)
        ReDim arrListR(1 To 10, 1 To 10)
        For i = LBound(arrList) To UBound(arrList)
            tmp = Split(Replace(arr(i - 1), " ", ""), vbTab)
            For j = LBound(arrList, 2) To UBound(arrList, 2)
                arrList(i, j) = CDbl(tmp(j))
            Next j
        Next i
        Blatt.Range(Zellen(0)).Resize(UBound(arrList, 1), UBound(arrList, 2)) = arrList
        For i = LBound(arrList) To UBound(arrList)
            tmp = Split(Replace(arr(i + 9), " ", ""), vbTab)
            For j = LBound(tmp) + 1 To UBound(tmp) - 1 Step 2
                k = k + 1
                arrList(i, k) = CDbl(tmp(j))
                arrListR(i, k) = CDbl(tmp(j + 1))
            Next j
            k = 0
        Next i
        Blatt.Range(Zellen(1)).Resize(UBound(arrList, 1), UBound(arrList, 2)) = arrList
        Blatt.Range(Zellen(2)).Resize(UBound(arrListR, 1), UBound(arrListR, 2)) = arrListR
    End If
End Sub

Gruß Uwe

[snb]

Makellos mit:

Code:

Sub M_snb()
 c00="G:\"
 For j = 1 To 2
   With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
     .SetText Join(Filter(Split(CreateObject("scripting.filesystemobject").opentextfile(c00 & Choose(j, "10BGW", "10LCL") & ".txt").readall, vbCrLf), "RLU"), vbCr)
     .PutInClipboard
     .GetFromClipboard
     Sheet1.Paste Cells(15 + 25 * (j - 1), 3)
   End With
 Next
End Sub

[Egon12]

@snb,

das hatte ich auch schon bei den Anfangsvorgaben in #6 mit der Wahl Funktion für mich getestet, da der TO aber mit einzelnen Buttons arbeiten wollte wieder verworfen und die Prozedur verständlich parametrisiert.

Das eigentliche Problem dieser Vorgehensweise ist und bleibt die Nutzung des Clippboard Objektes. Es arbeitet nicht zuverlässig.
Bei meinen vorhandenen Konfigurationen: O2019/Win10 PC und O2021/Win11 Laptop werden nur die Zeilenumbrüche ins Objekt geladen. Der Rest ist dann weg.

Bei deinem Rechner klappt es offenbar.

Wenn man diesen Weg gehen will bleibt nur dies via API als einzig zuverlässig funktionende Verarbeitung per Clippboard zu machen.

Wenn Textzahlen nicht stören wäre das so ein effizienter machbarer Weg.

Der letzte Stand des TO ist nun aber ein ganz anderer Aufbau der Textdatei, so dass hier der Vorteil der Parametrisierung der Prozedur für sich spricht und diese sich mit einer kleinen Erweiterung flexibel weiter nutzen lässt.

Schönes Wochenende

Gruß Uwe

[snb]

Das geht dann doch einfach so ?

Code:

Sub M_snb()
  For j = 1 To 2
    sn = Filter(Split(CreateObject("scripting.filesystemobject").opentextfile("G:\" & Choose(j, "10BGW", "10LCL") & ".txt").readall, vbCrLf), "RLU")
    For jj = 0 To UBound(sn)
      Sheet1.Cells(15 + 25 * (j - 1) + jj, 3).Resize(, 11) = Split(sn(jj), vbTab)
    Next
  Next
End Sub

- Text wird von Excel umgewandelt in Numbers.
- welche andere 'Aufbau ' ?

[Egon12]

@snb,

schau in #18 und #29
Ich habe gerade festgestellt, dass interne Linkadressen derzeit wohl blockiert werden.

Gruß Uwe

[RPP63]

Ich habe Deinen Beitrag mal gemeldet, Uwe.
Die direkte Verlinkung funktioniert auch nicht, siehe
[url=
Dateiupload bitte im Forum! So geht es: Klick mich!
]

[Egon12]

Ja. 
Hilfe auf die Idee hätte ich selbst kommen können. War wohl noch nicht richtig munter.

Gruß Uwe

Ps.: Auf Tablette schreiben ist was Furchtbares.

[Kuwer]

Hi Ralf,

jetzt klappt es: #36

Ursache war das Wort Upload im Threadtitel, das ich jetzt entfernt habe.

Gruß, Uwe

[snb]

Kein Problem in VBA:

Code:

Sub M_snb()
  sn = Filter(Split(CreateObject("scripting.filesystemobject").opentextfile("G:\10LCL10LCR10BGW.txt").readall, vbCrLf), "RLU")
 
  For j = 0 To 9
    st = Split(sn(j + 10), vbTab)
    Sheet1.Cells(15 + j, 3).Resize(, 11) = Split(sn(j), vbTab)
    Sheet1.Cells(40 + j, 4).Resize(, 10) = Array(st(1), st(3), st(5), st(7), st(9), st(11), st(13), st(15), st(17), st(19))
    Sheet1.Cells(65 + j, 4).Resize(, 10) = Array(st(2), st(4), st(6), st(8), st(10), st(12), st(14), st(16), st(18), st(20))
  Next
End Sub