Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1484to1488
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

VBA Spalten in Textdateien auslesen & einfügen

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

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA Spalten in Textdateien auslesen & einfügen
13.04.2016 13:01:19
Fennek
Hallo,
ungetestet, vielleicht sind die Dateien "Zone" und "Temp" verwechselt.
mfg

Sub sMoe()
'Version 3
Dim WBZ As Workbook 'Ziel
Dim WBQ As Workbook 'Quelle
sPfad = "c:\temp\" 'anpassen
sFile = Array("Temperatures.prn", "Zone-Energy.prn", "weitere Datei")
Set WBZ = ThisWorkbook
For i = 0 To 1 'Auswahl der Dateien
Set WBQ = Workbooks.Open(sPfad & sFile(i))
If Application.DecimalSeparator = "," Then
WBQ.Sheets(1).Columns(1).Replace ".", ","
End If
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
Select Case i
Case 0
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")
Case 1
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 Select
WBQ.Close 0
Next i
'WBZ.Close 1
End Sub

Anzeige
AW: VBA Spalten in Textdateien auslesen & einfügen
13.04.2016 13:30:58
Moe
Hoi Fennek
Danke, das mit den beiden Files und dem Array funktioniert!
Leider kopiert es jetzt nur die Spalten "tairmean" und "q_equip" und macht dazwischen eine leere Spalte!? Ich möchte gerne diese vier Spalten kopieren: "tairmean", "top", "q_heat" und "q_cool". Wie sieht es aus mit der Eingabe der gewünschten Spalten per Namen, ist dies möglich? Wenn ja, wie? ;)
Gruss,
Moe

AW: VBA Spalten in Textdateien auslesen & einfügen
13.04.2016 13:46:36
Fennek
Hi Moe,
ich habe den Eindruck, dass du wiederholt die Aufgabenstellung veränderst/modifizierst. Damit kann ich nicht umgehen.
Alle notwendige Codes zum Kopieren von Spalten sind als Beispiel im vorliegenden Code enthalten. Versuche dich an den Änderungen.
Mfg

Anzeige
AW: VBA Spalten in Textdateien auslesen & einfügen
13.04.2016 14:06:17
Moe
Hi Fennek
Es tut mit leid, wenn das so rüberkommt. Jedoch hat sich meine Aufgabenstellung nicht verändert. Ich möchte nur, anstatt die Spalten mit Nummern, mit den Namen auslesen, was für mich übersichtlicher ist. Leider weiss ich nicht ob und wie das geht...
Schon bis jetzt Danke für deine Hilfe!
Gruss
Moe

AW: die unendliche Gesschichte??? owT
14.04.2016 10:24:41
Fennek

Sub sMoe()
'Version 3.1
Dim WBZ As Workbook 'Ziel
Dim WBQ As Workbook 'Quelle
sPfad = "c:\temp\" 'anpassen
sFile = Array("Zone-Energy.prn", "Temperatures.prn", "weitere Datei")
Set WBZ = ThisWorkbook
'löschen des Datenbereichs
Range("D10", Cells(10, 4).End(xlDown).End(xlToRight)).Clear
For i = 0 To 1 'Auswahl der Dateien
Set WBQ = Workbooks.Open(sPfad & sFile(i))
If Application.DecimalSeparator = "," Then
WBQ.Sheets(1).Columns(1).Replace ".", ","
End If
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
myCol = Spalte(WBQ.Name)  'sucht nach ausgewählten Spalten, NUR als Demo!!!!
Select Case i
Case 0
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") 'q_cool
WBQ.Sheets(1).Range(Cells(1, "F"), Cells(lrq, "F")).Copy WBZ.Sheets(1).Cells(lrz, "E") 'q_heat
Case 1
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, "D"), Cells(lrq, "D")).Copy WBZ.Sheets(1).Cells(lrz, "F") ' _
tairmean
WBQ.Sheets(1).Range(Cells(1, "E"), Cells(lrq, "E")).Copy WBZ.Sheets(1).Cells(lrz, "G") 'top
Case Else
'weitere Dateien
End Select
WBQ.Close 0
Next i
'WBZ.Close 1
End Sub
Function Spalte(wbName As String)
Dim rng As Range
Sp = Array("q_cool", "q_heat", "tearmean", "top")
With Workbooks(wbName).Sheets(1).Rows(1)
For Each s In Sp
Set rng = .Find(s)
If Not rng Is Nothing Then MsgBox "Gefunden: " & s & " in Spalte " & rng.Column: Spalte = rng. _
Column
Next s
End With
End Function

Anzeige
AW: VBA Spalten aus Textdateien kopieren
15.04.2016 17:58:49
Moe
Hoi Fennek
Danke! Das mit den Spaltennamen ist PERFEKT! Und ja, es ist eine Art eine unendliche Geschichte... ;/
Wenn ich den Code richtig verstehe, muss ich eingeben, wo die gewünschte Spalte im Tabellenblatt eingefügt wird. Bei 500 - 1000 Spalten ist das unmöglich. Gibt es einen Weg, dass es "automatisch" in die nächste leere Spalte einfügt?
Danke und Gruss,
Moe

AW: VBA Spalten aus Textdateien kopieren
16.04.2016 11:51:25
Fennek
Hi Moe,
der Beitrag liegt mittlerweile 'hinter der Erdkrümmung', reiner Zufall, dass ich deine Antwort gesehen habe.
Ähnlich wie die letzte Zeile kann man auch die letzte benutzte Spalte ermitteln:

Cells(10, columns.count).end(xltoleft).column + 1
Mfg
Ps falls es weitere Fragen haben sollte, mach einen neuen Beitrag auf, so weit hinten sieht das niemand

Anzeige

384 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige