VBA Spalten in Textdateien auslesen & einfügen
13.04.2016 11:32:59
Moe
Hallo zusammen
Ich möchte gerne per VBA Spalten aus prn-files auslesen und in das aktive Registerblatt ab der Zelle D10 kopieren.
Dies ist mein aktueller Code:
Sub Spalten_einfügen2() 'Version 2
Dim WBZ As Workbook 'Ziel
Dim WBQ As Workbook 'Quelle
sPfad = "C:\WORK\TransferLocal\01_Projekte\Python-Script\Beispiel_Test\" 'anpassen
Set WBZ = ThisWorkbook 'Set WBZ = Workbooks.Open(sPfad & "Moe_Ziel.xlsx")
sDatei = Dir(sPfad & "ZONE-ENERGY.prn") 'anpassen, z.B. Temperatures.prn
Do Until sDatei = ""
Set WBQ = Workbooks.Open(sPfad & sDatei)
Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array( _
_
13, 1 _
), Array(14, 1)), TrailingMinusNumbers:=True
If Not (Rows("1:1").Find("q_cool")) Is Nothing Then
lrq = WBQ.Sheets(1).Cells(Rows.Count, "D").End(xlUp).Row
lrz = WBZ.Sheets(1).Cells(Rows.Count, "D").End(xlUp).Row + 1
lrz = IIf(lrz > 10, lrz, 10)
WBZ.Sheets(1).Cells(lrz, "A") = WBQ.Name
WBQ.Sheets(1).Range(Cells(1, "D"), Cells(lrq, "D")).Copy WBZ.Sheets(1).Cells(lrz, "D")
WBQ.Sheets(1).Range(Cells(1, "F"), Cells(lrq, "F")).Copy WBZ.Sheets(1).Cells(lrz, "E")
Else
lrz = WBZ.Sheets(1).Cells(Rows.Count, "F").End(xlUp).Row + 1
lrz = IIf(lrz > 10, lrz, 10)
WBZ.Sheets(1).Cells(lrz + 1, "A") = WBQ.Name
WBQ.Sheets(1).Range(Cells(1, "E"), Cells(lrq, "E")).Copy WBZ.Sheets(1).Cells(lrz, "F")
End If
WBQ.Close 0
sDatei = Dir
Loop
'WBZ.Close 1
End Sub
Folgendes möchte ich ergänzen, schaffe es aber nicht: Ich möchte gerne, dass es nicht nur das prn-file "ZONE-ENERGY" ( https://www.herber.de/bbs/user/104926.txt ) ausliest, sondern auch noch TEMPERATURES.prn ( https://www.herber.de/bbs/user/104927.txt ). Bei diesem File soll es die Spalte "tairmean" und "top" kopieren.
Algemein möchte ich, dass ich die Spalten mit dem Namen in der ersten Zeile bestimme und auslese (später kommen noch mehr Spalten dazu, deshalb wäre eine einfache Eingabe mit dem Namen am besten und übersichtlichsten), z.B. Spalten zum Auslesen = "q_cool"; "q_heat"; "tairmean"; "top"; usw... Danach "durchforstet" das Skript alle angegebenen prn-files und kopiert die entsprechenden Spalten in die Tabelle.
Kann mir da jemand weiterhelfen? Danke für euere Hilfe!
Gruss
Moe