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

Dezimalstellendarstellung

Dezimalstellendarstellung
05.10.2016 14:12:49
Tim
Hallo Zusammen! Diesen Code habe ich in Kooperation mit einem Forumsmitglied erstellt. Ich dachte auch alles würde gut laufen, aber jetzt ist mir aufgefallen, dass die Dezimalstellen bei der Excel Datei geändert werden in "." statt "," und so die Diagramme und ähnliche es für eine Tausenderabgrenzung halten. Die Original Excel ist durch "," getrennt.
Sub Schaltfläche1_Klicken()
Dim WB As Workbook
Dim iXLS As String
Dim iLOG As String
Dim filename As String
Dim pfad 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), ".LOG") > 0 Then iLOG = sFiles(i)
Next i
Set WB = Workbooks.Open(iXLS)
WB.Sheets.Add , WB.Sheets(Sheets.Count), , iLOG
' Log-Bearbeitung
Dim rng As Long
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 = " & _
" mode = measurement mode: OK/ZERO/SPAN = 0/1/2" & Chr(13) & "" & Chr(10) & " 1"
Columns("A:A").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Rows("2:5").Select
Selection.Delete Shift:=xlUp
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
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"
rng = Range("B65526").End(xlUp).Row
Range("A3").Select
Selection.AutoFill Destination:=Range(Cells(3, 1), Cells(rng, 1)), Type:=xlFillDefault
ActiveSheet.Previous.Select
' xls-Bearbeitung
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
' Speichern
filename = Replace(WB.Name, ".xls", "")
MsgBox filename
pfad = "D:\Eigene Dateien\" & filename & ".xlsx"
MsgBox pfad
WB.SaveAs pfad
WB.SaveAs filename:=pfad, FileFormat:=xlOpenXMLWorkbook
End Sub


ICh weiß der Code ist lang, aber ich kann den Fehler nicht identifizieren, deswegen das volle Skript!

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Dezimalstellendarstellung
05.10.2016 23:26:44
Piet
Hallo
ich habe den Code mal etwas umgeschrieben, alle Selection herausgenommen. Sind unnötig.
Ob der Fehler damit beseitigt ist weiss ich nicht. Bitte selbst testen.
mfg Piet
Sub Schaltfläche1_Klicken()
Dim WB As Workbook
Dim iXLS As String
Dim iLOG As String
Dim filename As String
Dim pfad 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), ".LOG") > 0 Then iLOG = sFiles(i)
Next i
Set WB = Workbooks.Open(iXLS)
WB.Sheets.Add , WB.Sheets(Sheets.Count), , iLOG
' Log-Bearbeitung
Dim rng As Long
Range("A2").FormulaR1C1 = _
" Measuring length:  1.010 meter" & Chr(13) & "" & Chr(10) & " PC-time: Mon Aug 01 11:  _
16:14 2016"
Range("A1").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").FormulaR1C1 = _
" sec = seconds after midnight (PC-time)" & Chr(13) & "" & Chr(10) _
& " GasName-LineNo/i/a/s = gas concentration inst/avg/std"
Range("A1").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").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").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").FormulaR1C1 = _
" mode = measurement mode: OK/ZERO/SPAN = 0/1/2" & Chr(13) & "" & Chr(10) & " 1"
Range("A1").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 = " & " mode = measurement mode: OK/ZERO/SPAN = 0/1/2" & Chr(13) & "" _
& Chr(10) & " 1"
Columns("A:A").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Rows("2:5").Delete Shift:=xlUp
'1. With entfaellt duech die 2. With Klammer
With Range("A1:X1")
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
Range("A1:X1").Merge
Rows("1:1").RowHeight = 160.5
Range("A2").FormulaR1C1 = "time"
Range("A3").FormulaR1C1 = "=RC[1]/86400"
Range("A3").NumberFormat = "[$-F400]h:mm:ss AM/PM"
rng = Range("B65526").End(xlUp).Row
Range("A3").AutoFill Destination:=Range(Cells(3, 1), Cells(rng, 1)), Type:=xlFillDefault
ActiveSheet.Previous.Select
' xls-Bearbeitung
Columns("A:A").EntireColumn.AutoFit
Columns("C:C").EntireColumn.AutoFit
Columns("E:E").EntireColumn.AutoFit
Columns("G:G").EntireColumn.AutoFit
Application.CutCopyMode = False
With Range("B3:H3")
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
'davor steht Merge = False!  Warum jetzt doch Merge?
'Range("B3:H3").Merge
Range("A7").Delete Shift:=xlToLeft
' Speichern
filename = Replace(WB.Name, ".xls", "")
MsgBox filename
pfad = "D:\Eigene Dateien\" & filename & ".xlsx"
MsgBox pfad
WB.SaveAs pfad
WB.SaveAs filename:=pfad, FileFormat:=xlOpenXMLWorkbook
End Sub

Anzeige
AW: Dezimalstellendarstellung
06.10.2016 08:41:50
fcs
Hallo Tim,
von welchem Datei-Typ sind den die LOG-Dateien?
Das scheinen ja verkappte xls-Dateien zu sein, denn sonst würde die Zeile
 WB.Sheets.Add , WB.Sheets(Sheets.Count), , iLOG

nicht funktionieren.
Evtl. ist die LOG-Datei auf einem PC mit anderen Länder-Einstellungen erstellt worden, so dass es beim Zusammenführen zum Darstellungs-Chaos kommt.
Was passiert denn, wenn du die LOG-Datei direkt mit Excel öffnest.
Wahrscheinlich ist es besser die LOG-Datei separat zu öffnen und dann in die xls-Datei zu kopieren/versschieben.
Piet hat dir deinen Code ja schon etwas etwas optimiert. Beim Eintragen des Textes in Zelle A1 ist aber noch mehr drin.
Die Formeln in A2 bis A4 musst du nicht eintragen. denn diese Zeilen werden ja wieder gelöscht. Evtl ist es auch sinnvoller, den Text für A1 aus Zellinhalten in der LOG-Datei zusammenzubasteln.
Gruß
Franz
Sub Schaltfläche1_Klicken()
Dim WB As Workbook, wksXLS As Worksheet, wksLOG As Worksheet
Dim iXLS As String
Dim iLOG As String
Dim filename As String
Dim pfad As String
Dim rng As Long
Dim sfiles As Variant
Dim i As Integer
Dim sA1 As String
sfiles = Application.GetOpenFilename("Dateien (*.xls;*.LOG), *.xls;*.LOG", _
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), ".LOG") > 0 Then iLOG = sfiles(i)
Next i
If iXLS = "" Or iLOG = "" Then
MsgBox "Es wurde keine xls- oder LOG-Datei ausgewählt!"
Exit Sub
End If
Set WB = Application.Workbooks.Open(iXLS, ReadOnly:=True)
Set wksXLS = WB.Sheets(WB.Sheets.Count)
WB.Sheets.Add After:=WB.Sheets(Sheets.Count), Type:=iLOG
Set wksLOG = WB.Sheets(WB.Sheets.Count)
With wksLOG
' Log-Bearbeitung
sA1 = " Instrument serial number:  2616" & Chr(10)
sA1 = sA1 & " LineNo-GasName-Unit: 1-O2-% " & Chr(10)
sA1 = sA1 & " Measuring length:  1.010 meter" & Chr(10)
sA1 = sA1 & " PC-time: Mon Aug 01 11:16:14 2016" & Chr(10)
sA1 = sA1 & " sec = seconds after midnight (PC-time)" & Chr(10)
sA1 = sA1 & " GasName-LineNo/i/a/s = gas concentration inst/avg/std" & Chr(10)
sA1 = sA1 & " LineNo-lw/lp/la = line width/line position/line amplitude" & Chr(10)
sA1 = sA1 & " sts = instrument status: SLEEPMODE/STARTUP/OK/WARNING/ERROR = -4/-1/0/1/2" _
& Chr(10)
sA1 = sA1 & " mode = mode = measurement mode: OK/ZERO/SPAN = 0/1/2" & Chr(10)
sA1 = sA1 & " 1"
.Range("A1").Value = sA1
.Columns("A:A").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
.Rows("2:5").Delete Shift:=xlUp
With .Range("A1:X1")
.Merge
.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
.Range("A2").FormulaR1C1 = "time"
.Range("A3").FormulaR1C1 = "=RC[1]/86400"
.Range("A3").NumberFormat = "[$-F400]h:mm:ss AM/PM"
rng = .Cells(.Rows.Count, 2).End(xlUp).Row
.Range("A3").AutoFill Destination:=.Range(.Cells(3, 1), .Cells(rng, 1)), _
Type:=xlFillDefault
End With
' xls-Bearbeitung
With wksXLS
.Select
.Columns("A:A").EntireColumn.AutoFit
.Columns("C:C").EntireColumn.AutoFit
.Columns("E:E").EntireColumn.AutoFit
.Columns("G:G").EntireColumn.AutoFit
Application.CutCopyMode = False
With .Range("B3:H3")
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
.Range("B3:H3").Merge
.Range("A7").Delete Shift:=xlToLeft
End With
' Speichern
filename = Replace(WB.Name, ".xls", "")
MsgBox filename
pfad = "D:\Eigene Dateien\" & filename & ".xlsx"
pfad = "C:\Users\Public\Test\" & filename & ".xlsx"
MsgBox pfad
'    WB.SaveAs pfad
pfad = "C:\Users\Public\Test\" & filename & ".xlsx"
WB.SaveAs filename:=pfad, FileFormat:=xlOpenXMLWorkbook
End Sub

Anzeige
AW: Dezimalstellendarstellung
06.10.2016 12:11:56
Tim
Hallo Zusammen,
danke erst einmal für die Rückmeldung. Die .LOG Dateien sind Text-Dateien. Windows öffnet sie automatisch mit dem Editor. Die .LOG Datei ist aber auch mit "," als Dezimaloperator gekennzeichnet. Im Anhang mal die .LOG und die Original .XLS.
https://www.herber.de/bbs/user/108623.zip
Eure Optimierungen werde ich prüfen sobald ich kann.
Danke! Liebe Grüße Tim
AW: Dezimalstellendarstellung
06.10.2016 21:43:05
fcs
Hallo Tim,
deine xls-Datei ist in Wirklichkeit eine Textdatei mit:
TAB als Trennzeichen zwischen Spalten
Komma als Dezimalzeichen.
Öffnet man diese Datei in Excel mit deutschen Systemeinstellung direkt in Excel, dann ist bis auf Zelle A7 alles in Ordnung.
Wird die gleiche Datei per VBA-Makro geöffnet, dann wird automatisch mit US-Einstellungen gearbeitet. Also Punkt als Dezimal-Zeichen und Komma als 1000er Trennzeichen. Dadurch gibt es nach dem Öffnen per VBA die geänderte Darstellung der Zahlenwerte.
Für eine korrekte Darstellung muss die Datei im Makro mit dem zusätzlichen Parameter Local:=True geöffnet werden. Außerdem müssen die Zahlenwerte noch mit 3 Nachkommastellen formatiert werden.
In deiner LOG-Datei ist das Spaltentrennzeichen ebenfalls das TAB, das Dezimalzeichen ist der Punkt. Dadurch ist unter VBA der Import einigermaßen in Ordnung.
Hier sollten nach dem Öffnen die Texte in den Zellen A1:A5 in einer Variablen gesammelt werden und später in A1 eingefügt werden. Dann stimmt der Text in der Exceldatei inklusive Datum/Uhrzeit mit der LOG-Datei überein.
Gruß
Franz
Sub Schaltfläche1_Klicken()
Dim WB As Workbook, wksXLS As Worksheet, wksLOG As Worksheet
Dim iXLS As String
Dim iLOG As String
Dim filename As String
Dim pfad As String
Dim rng As Long, lngCol As Long
Dim sfiles As Variant
Dim i As Integer
Dim sA1 As String
sfiles = Application.GetOpenFilename("Dateien (*.xls;*.LOG), *.xls;*.LOG", _
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), ".LOG") > 0 Then iLOG = sfiles(i)
Next i
If iXLS = "" Or iLOG = "" Then
MsgBox "Es wurde keine xls- oder LOG-Datei ausgewählt!"
Exit Sub
End If
Set WB = Application.Workbooks.Open(iXLS, ReadOnly:=True, Local:=True)
Set wksXLS = WB.Sheets(WB.Sheets.Count)
WB.Sheets.Add After:=WB.Sheets(Sheets.Count), Type:=iLOG
Set wksLOG = WB.Sheets(WB.Sheets.Count)
With wksLOG
' Log-Bearbeitung
sA1 = .Cells(1, 1).Text
sA1 = sA1 & Chr(10) & .Cells(2, 1).Text
sA1 = sA1 & Chr(10) & .Cells(3, 1).Text
sA1 = sA1 & Chr(10) & .Cells(4, 1).Text
sA1 = sA1 & Chr(10) & .Cells(5, 1).Text
sA1 = Left(sA1, Len(sA1) - 3)
.Columns("A:A").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
.Rows("2:5").Delete Shift:=xlUp
.Rows(1).ClearContents
.Range("A1").Value = sA1
lngCol = .UsedRange.Column + .UsedRange.Columns.Count - 1
With .Range(.Cells(1, 1), .Cells(1, lngCol))
.Merge
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
.Rows("1:1").RowHeight = 152
.Range("A2").FormulaR1C1 = "time"
.Range("A3").FormulaR1C1 = "=RC[1]/86400"
.Range("A3").NumberFormat = "[$-F400]h:mm:ss AM/PM"
rng = .Cells(.Rows.Count, 2).End(xlUp).Row
.Range("A3").AutoFill Destination:=.Range(.Cells(3, 1), .Cells(rng, 1)), _
Type:=xlFillDefault
End With
Range("B3").Select
ActiveWindow.FreezePanes = True
' xls-Bearbeitung
With wksXLS
.Select
.Columns("A:A").EntireColumn.AutoFit
.Columns("C:C").EntireColumn.AutoFit
.Columns("E:E").EntireColumn.AutoFit
.Columns("G:G").EntireColumn.AutoFit
Application.CutCopyMode = False
With .Range("B3:H3")
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
.Range("B3:H3").Merge
.Range("A7").Delete Shift:=xlToLeft
With .Range(Rows(6), .Rows(6))
.WrapText = True
.VerticalAlignment = xlCenter
.AutoFit
End With
lngCol = .UsedRange.Column + .UsedRange.Columns.Count - 1
rng = .Cells(.Rows.Count, 1).End(xlUp).Row
With .Range(.Cells(7, 2), .Cells(rng, lngCol))
.NumberFormat = "0.000;-0.000;0.000;@"
End With
End With
Range("B7").Select
ActiveWindow.FreezePanes = True
' Speichern
filename = Replace(WB.Name, ".xls", "")
MsgBox filename
pfad = "D:\Eigene Dateien\" & filename & ".xlsx"
pfad = "C:\Users\Public\Test\" & filename & ".xlsx"
MsgBox pfad
'    WB.SaveAs pfad
WB.SaveAs filename:=pfad, FileFormat:=xlOpenXMLWorkbook
End Sub

Anzeige
AW: Dezimalstellendarstellung
09.10.2016 08:03:16
Tim
Guten Morgen,
vielen Dank für die Tipps. Ich dachte mir schon das es an den Ländereinstellung liegt. Es funktioniert jetzt auch für alle Spalten außer für die 02 Spalten und den Druck (C,D,G). Habt ihr dafür auch noch eine Idee? Das wäre Klasse.
Einen schönen Sonntag euch
AW: Dezimalstellendarstellung
09.10.2016 10:59:16
fcs
Hallo Tim,
Es funktioniert jetzt auch für alle Spalten außer für die 02 Spalten und den Druck (C,D,G). Habt ihr dafür auch noch eine Idee?
Wie soll man denn eine Idee haben, wenn nicht bekannt ist, welche Probleme es mit den Spalten gibt.
LG
Franz
AW: Dezimalstellendarstellung
09.10.2016 11:37:38
Tim
War wohl doch noch etwas früh Franz.
In den Spalten C udn D stehen prozentuale Angaben, aber nach der Verwendung der Makros und der Änderung die ihr vorgeschlagen habt, stehen hier immer noch Werte von 12.XXX anstatt 12,XXX. Der Druck in Spalte "G" ist ein fester Wert von 1,013 bar, hier wäre es z.Z. nicht so schlimm, wenn die Formatierung so bleibt. ABER es interessiert mich trotzdem woher das Problem kommen könnte...
LG
Tim
Anzeige
AW: Dezimalstellendarstellung
10.10.2016 04:49:42
fcs
Hallo Tim,
bei mir sieht die vom Makro zusammengefügte Datei wie folgt aus, wenn ich Excel starte, dann die Datei mit dem Makro öffne und das Makro ausführe.
https://www.herber.de/bbs/user/108685.xlsx
Betriebssystem: Windows 10 - Deutsch
Office 365 (Excel 2016) - Deutsch
Da sieht alles OK aus.
Das Problem ist wahrscheinlich die Art und Weise, wie du die die Daten der LOG-Datei in ein zusätzliches Tabellenblatt lädst.
    WB.Sheets.Add After:=WB.Sheets(Sheets.Count), Type:=iLOG

Das ist etwas unorthodox - zumindest für mich.
Ich öffne normalerweise die Textdatei mit allen erforderlichen Parametern in einer separaten Arbeitsmappe und kopieren dann die Daten in meine Arbeitsdatei. Die Textdatei wird dannach ohne Speichern wieder geschlossen.
Nachfolgend das Makro mit den erforderlichen Anpassungen.
LG
Franz
Sub Schaltfläche1_Klicken()
Dim WB As Workbook, wksXLS As Worksheet, wksLOG As Worksheet
Dim iXLS As String
Dim iLOG As String
Dim filename As String
Dim pfad As String
Dim rng As Long, lngCol As Long
Dim sfiles As Variant
Dim i As Integer
Dim sA1 As String
Dim wkbLOG As Workbook
sfiles = Application.GetOpenFilename("Dateien (*.xls;*.LOG), *.xls;*.LOG", _
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), ".LOG") > 0 Then iLOG = sfiles(i)
Next i
If iXLS = "" Or iLOG = "" Then
MsgBox "Es wurde keine xls- oder LOG-Datei ausgewählt!"
Exit Sub
End If
Set WB = Application.Workbooks.Open(iXLS, ReadOnly:=True, Local:=True)
Set wksXLS = WB.Sheets(WB.Sheets.Count)
WB.Worksheets.Add After:=WB.Sheets(Sheets.Count)
Set wksLOG = WB.Sheets(WB.Sheets.Count)
'LOG-Datei als Textdatei öffnen und Inhalt kopieren
Application.Workbooks.OpenText filename:=iLOG, origin:=xlWindows, _
DataType:=xlDelimited, Tab:=True, Semicolon:=False, Comma:=False, _
Space:=False, Other:=False, DecimalSeparator:=".", ThousandsSeparator:=","
Set wkbLOG = ActiveWorkbook
wkbLOG.Worksheets(1).UsedRange.Copy Destination:=wksLOG.Range("A1")
wksLOG.Name = wkbLOG.Worksheets(1).Name
'LOG-Datei ohne speichern wieder schließen
Application.DisplayAlerts = False
wkbLOG.Close savechanges:=False
Application.DisplayAlerts = True
Set wkbLOG = Nothing
With wksLOG
' Log-Bearbeitung
sA1 = .Cells(1, 1).Text
sA1 = sA1 & Chr(10) & .Cells(2, 1).Text
sA1 = sA1 & Chr(10) & .Cells(3, 1).Text
sA1 = sA1 & Chr(10) & .Cells(4, 1).Text
sA1 = sA1 & Chr(10) & .Cells(5, 1).Text
sA1 = sA1 & Chr(10) & .Cells(6, 1).Text
sA1 = sA1 & Chr(10) & .Cells(7, 1).Text
sA1 = sA1 & Chr(10) & .Cells(8, 1).Text
sA1 = sA1 & Chr(10) & .Cells(9, 1).Text
.Columns("A:A").Insert shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
.Rows("2:10").Delete shift:=xlUp
.Rows(1).ClearContents
.Range("A1").Value = sA1
lngCol = .UsedRange.Column + .UsedRange.Columns.Count - 1
With .Range(.Cells(1, 1), .Cells(1, lngCol))
.Merge
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
.Rows("1:1").RowHeight = 152
.Range("A2").FormulaR1C1 = "time"
.Range("A3").FormulaR1C1 = "=RC[1]/86400"
.Range("A3").NumberFormat = "[$-F400]h:mm:ss AM/PM"
rng = .Cells(.Rows.Count, 2).End(xlUp).Row
.Range("A3").AutoFill Destination:=.Range(.Cells(3, 1), .Cells(rng, 1)), _
Type:=xlFillDefault
End With
Range("B3").Select
ActiveWindow.FreezePanes = True
' xls-Bearbeitung
With wksXLS
.Select
.Columns("A:A").EntireColumn.AutoFit
.Columns("C:C").EntireColumn.AutoFit
.Columns("E:E").EntireColumn.AutoFit
.Columns("G:G").EntireColumn.AutoFit
Application.CutCopyMode = False
With .Range("B3:H3")
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
.Range("B3:H3").Merge
.Range("A7").Delete shift:=xlToLeft
With .Range(Rows(6), .Rows(6))
.WrapText = True
.VerticalAlignment = xlCenter
.AutoFit
End With
lngCol = .UsedRange.Column + .UsedRange.Columns.Count - 1
rng = .Cells(.Rows.Count, 1).End(xlUp).Row
With .Range(.Cells(7, 2), .Cells(rng, lngCol))
.NumberFormat = "0.000;-0.000;0.000;@"
End With
End With
Range("B7").Select
ActiveWindow.FreezePanes = True
' Speichern
filename = Replace(WB.Name, ".xls", "")
MsgBox filename
pfad = "D:\Eigene Dateien\" & filename & ".xlsx"
MsgBox pfad
'    WB.SaveAs pfad
WB.SaveAs filename:=pfad, FileFormat:=xlOpenXMLWorkbook
End Sub

Anzeige
AW: Dezimalstellendarstellung
11.10.2016 08:12:16
Tim
Vielen Dank! Normalerweise importiere ich die auch mit diesen Einstellungen, aber ich wusste mir nicht anders zu helfen zu Beginn dieser Programmierung.
Ohne euch hätte ich echt Probleme. Also noch einmal: herzlichen Dank!
LG
Tim

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige