Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1504to1508
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

Excel File und Text-File in neuen Excel-File

Excel File und Text-File in neuen Excel-File
02.08.2016 09:18:56
Tim
Hallo Leute!
Ich habe schon viel in eurem Forum gelesen und auch schon einige Ideen gesammelt, aber so richtig vorwärts komme ich nicht, was auch an meinen mangelnden Kenntnissen liegen mag...ok wird.
Hier zu meinem Problem:
Ich bekomme an meinem Versuchsstand zwei Messdatenprotokolle, eine .xls-Datei und eine .txt-Datei, die aber zu einem Versuch gehören. Ich möchte jetzt die Beiden in einer Datei an einem neuen Ort speichern, benannt nach der .xls Datei.
Die Dateien sollen zusammen neu gespeichert werden und dazwischen von mir in Sachen Format angepasst werden, das klappt auch soweit alles schon ganz gut.
Das Problem an der Sache ist die Dateien heißen immer anders.
Jetzt zu meiner bisherigen "Leistung" :D

Sub Schaltfläche1_Klicken()
Workbooks.Add
ActiveWorkbook.SaveAs Filename:="D:\Eigene Dateien\C"
ActiveWorkbook.Close
End Sub
Sub Schaltfläche2_Klicken()
Dim Wkbname As String
Workbooks.Open "D:\Eigene Dateien\A"
Cells.Select
Selection.Copy
Workbooks("A.xlsx").Close False
Workbooks.Open "D:\Eigene Dateien\C"
ActiveSheet.Paste
ActiveWorkbook.Save
Workbooks("C.xlsx").Close False
End Sub


Mein Plan war also eine Datei mit Makros zu haben mit der die beiden Dateien geöffnet und in einer neuen gespeichert werden. Die Buchstaben "C" und "A" stehen hier nur als Platzhalter um das System zu verstehen. Hier sollte sich dann ein Dialogfenster öffnen, indem die Datei ausgewählt werden kann.
Vermutlich gibt es sicher noch fragen, denn es ist nicht so leicht in Worte zu fassen wie gedacht! Danke an alle die es sich überhaupt durchlesen!
Gruß Tim

18
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Excel File und Text-File in neuen Excel-File
02.08.2016 09:36:43
Fennek
Hallo,
wenn das Problem die verschiedenen Name sind, müßte es dazu Informationen geben. Z.B. wie man den Zusammenhang zwischen der xls- und der txt-Datei erkennen kann. Geht das per Namen, per Datum oder sonst wie? Liegen beide in einem Ordner?
mfg
AW: Excel File und Text-File in neuen Excel-File
02.08.2016 09:40:40
Tim
Also die beiden Dateien sollen händisch ausgewählt werden. Es gibt da kein Muster zur Zuordnung, daher die erstellte .txt-Datei von den Messgerät sowieso echt grausig ist.
Man wählt also einmal die Excel aus, da sieht der Dateiname so aus: Protokoll_Datum_Uhrzeit
und die .txt muss man suchen anhand des gespeicherten Datums.
Ich hoffe es wird verständlich
Anzeige
AW: Excel File und Text-File in neuen Excel-File
02.08.2016 09:57:31
Fennek
Hallo,
der folgende Code erlaubt das Auswählen der 2 Dateien und gibt die Namen im vba-Direktfenster aus.
Die Idee ist, dass der Makro die beiden (xls und txt) Dateien öffnet, bearbeitet und abspeichert.

Sub xls_txt_einlesen()
sFiles = Application.GetOpenFilename("alle Dateien (*.*), *.*", MultiSelect:=True)
If Not IsArray(sFiles) Then Exit Sub
For i = 1 To UBound(sFiles)
Debug.Print sFiles(i)
Next i
End Sub
mfg
AW: Excel File und Text-File in neuen Excel-File
02.08.2016 12:24:08
Tim
Aber die Speicherung erfolgt dann wieder in zwei separaten Dateien oder? Sie sollen aber in eine Datei mit zwei Sheets gespeichert werden. Benannt nach der Excel.
Danke erst einmal überhaupt für den letzte Code!
Anzeige
AW: Excel File und Text-File in neuen Excel-File
02.08.2016 13:35:56
Fennek
Hallo,
der gezeigte Code übernimmt nur die Auswahl. Die Zusammenfassung der beiden Dateien könnte gehen mit:
ungeprüft

dim WB as workbook
if right(sFiles(i),3) = "xls" then
set wb = workbooks.open ssFiles(i)
ws.sheets.add(,ws.sheets(sheet.count),sFiles(i+1)
ws.saveas neuer_Pfad_Name
ws.close
Dabei ist wichtig, dass zuerst die xls, dann die txt-Datei angesprochen wird, die gezeigte Code leistet das nicht, oder nur unter sehr bestimmten Umständen.
mfg
AW: Excel File und Text-File in neuen Excel-File
02.08.2016 14:18:47
Tim
Hallo,
diese zwei Zeilen scheinen einen Fehler zu beinhalten:
set wb = workbooks.open ssFiles(i)
ws.sheets.add(,ws.sheets(sheet.count),sFiles(i+1)
Aber ist es nicht leichter es step-by-step zu machen. Also eine Schaltfläche zu nehmen um die Excel auszuwählen, diese quasi an einem anderen Ort neu zu speichern und dann die Text-Datei da rein zu kopieren. Abschließend dann die Format-Änderungen
Nochmal in einfacher zusammengefasst was ich möchte zur Übersicht:
Excel "A" an Ort "X"
Text "B" an Ort "Y"
Excel "A" an Ort "Z"
Text zu Excel in "A" an Ort "Z"
Formatierung von Excel "A" an "Z"
Anzeige
AW: Excel File und Text-File in neuen Excel-File
02.08.2016 15:16:24
Fennek
set wb = workbooks.open ssFiles(i)
ws.sheets.add(,ws.sheets(sheet.count),sFiles(i+1)
hallo,
der code war einfach runtergeschrieben, mit dem Risiko von Tipfehlern und völlig vermurkster Syntax.
Aber einfache Tipfehler könnstest du finden, also
set wb = workbooks.open sFiles(i)
ws.sheets.add(,ws.sheets(sheets.count),sFiles(i+1)
Dieser code ist eine Anregung für deine Eigenleistung, sicher kein "copy-paste"-code
mfg
AW: getestete Version
02.08.2016 17:00:01
Fennek
Hallo,
hier mit kleinen Verbesserungen und getestet:

Sub xls_txt_einlesen()
Dim WB As Workbook
Dim iXLS As String
Dim iTXT As String
sFiles = Application.GetOpenFilename("alle Dateien (*.*), *.*", MultiSelect:=True)
If Not IsArray(sFiles) Then Exit Sub
If UBound(sFiles) > 2 Then MsgBox "zu viele Dateien": Exit Sub
For i = 1 To UBound(sFiles)
'Debug.Print sFiles(i)
If InStr(sFiles(i), ".xls") > 0 Then iXLS = sFiles(i)
If InStr(sFiles(i), ".txt") > 0 Then iTXT = sFiles(i)
Next i
Set WB = Workbooks.Open(iXLS)
WB.Sheets.Add , WB.Sheets(Sheets.Count), , iTXT
End Sub
mfg
Anzeige
AW: getestete Version
04.08.2016 08:49:52
Tim
Ihr ok DU bist der Hammer danke!!! Jetzt kann ich ganz normal mit der Save Funktion den neuen Speicherort definieren?
An welcher Stelle muss ich meine "Bearbeitung" einfügen? Werde dazu nachher mal den Code posten
Noch einmal vielen Dank dafür hätte ich verzweifelte Stunden in Massen geopfert
AW: getestete Version
04.08.2016 10:46:38
Tim
Wie angekündigt hier der Überarbeitungscode
Range("A2").Select
ActiveCell.FormulaR1C1 = _
" Measuring length: 1.010 meter" & Chr(13) & "" & Chr(10) & " PC-time: Mon Aug 01 11:16:14 2016"
Range("A1").Select
ActiveCell.FormulaR1C1 = _
" Instrument serial number: 2616" & Chr(13) & "" & Chr(10) & " LineNo-GasName-Unit: 1-O2-% " & Chr(10) & " Measuring length: 1.010 meter" & Chr(10) & " PC-time: Mon Aug 01 11:16:14 2016"
Range("A3").Select
ActiveCell.FormulaR1C1 = _
" sec = seconds after midnight (PC-time)" & Chr(13) & "" & Chr(10) & " GasName-LineNo/i/a/s = gas concentration inst/avg/std"
Range("A1").Select
ActiveCell.FormulaR1C1 = _
" Instrument serial number: 2616" & Chr(13) & "" & Chr(10) & " LineNo-GasName-Unit: 1-O2-% " & Chr(10) & " Measuring length: 1.010 meter" & Chr(10) & " PC-time: Mon Aug 01 11:16:14 2016" & Chr(10) & " sec = seconds after midnight (PC-time)" & Chr(10) & " GasName-LineNo/i/a/s = gas concentration inst/avg/std"
Range("A4").Select
ActiveCell.FormulaR1C1 = _
" LineNo-lw/lp/la = line width/line position/line amplitude" & Chr(13) & "" & Chr(10) & " sts = instrument status: SLEEPMODE/STARTUP/OK/WARNING/ERROR = -4/-1/0/1/2"
Range("A1").Select
ActiveCell.FormulaR1C1 = _
" Instrument serial number: 2616" & Chr(13) & "" & Chr(10) & " LineNo-GasName-Unit: 1-O2-% " & Chr(10) & " Measuring length: 1.010 meter" & Chr(10) & " PC-time: Mon Aug 01 11:16:14 2016" & Chr(10) & " sec = seconds after midnight (PC-time)" & Chr(10) & " GasName-LineNo/i/a/s = gas concentration inst/avg/std" & Chr(10) & " LineNo-lw/lp/la = line width/line position/line amplitude" & Chr(10) & " sts = instrument status: SLEEPMODE/STARTUP/OK/WARNING/ERROR = -4/-1/0/1/2"
Range("A5").Select
ActiveCell.FormulaR1C1 = " mode = measurement mode: OK/ZERO/SPAN = 0/1/2" & Chr(13) & "" & Chr(10) & " 1"
Range("A1").Select
ActiveCell.FormulaR1C1 = _
" Instrument serial number: 2616" & Chr(13) & "" & Chr(10) & " LineNo-GasName-Unit: 1-O2-% " & Chr(10) & " Measuring length: 1.010 meter" & Chr(10) & " PC-time: Mon Aug 01 11:16:14 2016" & Chr(10) & " sec = seconds after midnight (PC-time)" & Chr(10) & " GasName-LineNo/i/a/s = gas concentration inst/avg/std" & Chr(10) & " LineNo-lw/lp/la = line width/line position/line amplitude" & Chr(10) & " sts = instrument status: SLEEPMODE/STARTUP/OK/WARNING/ERROR = -4/-1/0/1/2" & Chr(10) & " mode = " & _
"ent mode: OK/ZERO/SPAN = 0/1/2" & Chr(10) & " 1"
Columns("A:A").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A2").Select
ActiveCell.FormulaR1C1 = "time"
Range("A3").Select
ActiveCell.FormulaR1C1 = "=RC[1]/86400"
Range("A3").Select
Selection.NumberFormat = "[$-F400]h:mm:ss AM/PM"
Range("A3").Select
Selection.AutoFill Destination:=Range("A3:A144"), Type:=xlFillDefault
Range("A3:A144").Select
ActiveWindow.SmallScroll Down:=-147
Range("A1:X1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
Rows("1:1").RowHeight = 160.5

Überarbeitung der schlechten txt-Datei.
Columns("A:A").EntireColumn.AutoFit
Columns("C:C").EntireColumn.AutoFit
Columns("E:E").EntireColumn.AutoFit
Columns("G:G").EntireColumn.AutoFit
Range("B3:H3").Select
Application.CutCopyMode = False
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Range("A7").Select
Selection.Delete Shift:=xlToLeft

Überarbeitung der xls.-Datei
Wäre schön, wenn das auch noch klappen würde
Anzeige
AW: getestete Version
04.08.2016 12:11:19
Tim
Danke mehr kann ich nicht sagen! Klasse Leistung. Den Rest habe ich selber gepackt
AW: getestete Version
04.08.2016 13:30:06
Tim
Jetzt muss ich doch noch mal was fragen...
Ich würde gerne die neue Datei speichern. Bekomme aber immer nur die Datei mit dem "Makro" und nicht die mit der xls-und txt-Datei drin...
Würde gerne die Datei automatisch an einem festgelegten Ort speichern mit dem Namen der geöffneten Excel
AW: getestete Version
04.08.2016 18:04:21
Fennek
Hallo,
schön, dass es geholfen hat.
Zum Speichern:
Zusätzlich zu
Set WB = Workbooks.Open(iXLS)
WB.Sheets.Add , WB.Sheets(Sheets.Count), , iTXT
End Sub

Set WB = Workbooks.Open(iXLS)
WB.Sheets.Add , WB.Sheets(Sheets.Count), , iTXT
'hier deine Codes
New_Name = "Pfad & filename"
WB.saveas new_name
End Sub
mfg
Anzeige
AW: getestete Version
05.08.2016 15:03:59
Tim
Hi, der Code speichert leider nur die erste geöffnete Excel und nicht die "neue" Datei aus xls und txt.
Dim filename As String
filename = WB.Name
new_name = "Pfad" & filename & ".xls"
WB.SaveAs new_name

Hatte es jetzt so geschrieben. Er übernimmt jetzt den richtigen Dateinamen aber halt nicht die komplette Datei...
AW: getestete Version
05.08.2016 15:21:27
Fennek
Hallo,
getestet, als letzte Zeile vor "End Sub":

wb.saveas "c:\temp\Ruddies.xlsx"
mfg
AW: getestete Version
05.08.2016 15:40:40
Tim
Hi,
hatte ich auch gemacht und funktioniert jetzt auch, ABER er kann den Dateityp dann nicht mehr öffnen, die Datei sei beschädigt, auch wenn ich 1:1 wie in deinem Beispiel mache
Anzeige
AW: hier geht es owt
05.08.2016 15:48:54
Fennek
Speicherproblem
05.08.2016 17:37:05
Tim
@Fennek
Du hast zwar geantwortet aber die Nachricht ist leider leer.

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige