AW: VBA Spalten in Textdateien auslesen & einfügen
11.04.2016 18:23:51
Fennek
Hallo,
mit deiner Angaben habe ich immer noch Probleme. Diese Version (2) list alle *.prn Dateieb eines Odners, unterscheidet 2 Arten, q_cool und top, und kopiert die relevanten Spalten.
Arbeitest du mit der englischen Version, also dem DezimalPUNKT? Dann erferne den 'Replace(".", ",") - Befehl.
Sub sMoe()
'Version 2
Dim WBZ As Workbook 'Ziel
Dim WBQ As Workbook 'Quelle
sPfad = "c:\temp\" 'anpassen
'Set WBZ = Workbooks.Open(sPfad & "Moe_Ziel.xlsx")
Set WBZ = ThisWorkbook
sDatei = Dir(sPfad & "*.prn") 'anpassen, z.B. Temperatures.prn
Do Until sDatei = ""
Set WBQ = Workbooks.Open(sPfad & sDatei)
WBQ.Sheets(1).Columns(1).Replace ".", ","
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
Für heute
mgf