Excel importiert Zahlen Falsch
30.08.2018 13:47:03
Marc
Hänge nun schon länger an diesem Problem:
Sobald ich eine Datei in Excel per VBA varDatei = Application.GetOpenFilename... auswähle und mit Workbooks.Open varDatei Einfüge wird aus "1,700" 1700.
Die "1,700" kommen aus SAP, sprich das Rohr ist 1,7 Meter lang. Das Phänomen tritt nur bei Zahlen auf die am Ende mit "X,X00" aufhören. eine "1,70" wird zB sauber als 1,7 erkannt genau wie eine "1,7". Wird die txt-Datei als .csv Importiert passiert genau das selbe, auch wenn beim vorherigem öffnen der .csv Datei eindeutig eine 1,7 in der Zelle steht. Der Code wurde am bestimmten Punkt gestoppt (nachdem die Datei von Excel geöffnet wurde, aber noch bevor es kopiert wird) hier wurde erkannt, dass der Fehler schon beim Öffnen der Datei auftritt.. jedoch nur wenn die Datei vom Excel Makro geöffnet wurde beim manuellen Öffnen passt alles.
Kann mir jemand weiterhelfen? Vielen Dank im Voraus!
https://www.herber.de/bbs/user/123657.xlsm
https://www.herber.de/bbs/user/123658.txt
hier noch der Code:
Sub Import()
' Import Makro
Dim wks As Worksheet
Dim wksDaten As Worksheet
Dim wkbDaten As Workbook
Dim rng As Range
On Error GoTo FEHLER
Dim Dateinameexcel As Variant
Dateinameexcel = ActiveWorkbook.Name
With Application
'Screen Updating False -> die bildschirmakutalisierung wird gestoppt
.ScreenUpdating = False
.EnableEvents = False
'.Calculation = xlCalculationManual
End With
Dim varDatei As Variant
varDatei = Application.GetOpenFilename( _
FileFilter:="TXT Files (*.txt),*.txt,XLS Files (*.xls),*.xls,XLSx Files (*.xlsx),*. _
xlsx,CSV Files (*.csv),*.csv", _
Title:="Select a single file (in future maybe more files selectable)", _
MultiSelect:=False)
If varDatei = False Then
MsgBox "Der Benutzer hat abgebrochen.", vbInformation
Exit Sub
End If
Dim varDateiname As Variant
varDateiname = Right(varDatei, InStr(1, StrReverse(varDatei), "\") - 1)
'MsgBox "varDateiname ist :" & varDateiname
Workbooks.Open varDatei, , , 1
' mit der 1 wird das Import-Format definiert hier wird nach Tabs getrennt
Set wkbDaten = Workbooks(varDateiname)
Set wksDaten = wkbDaten.Sheets("Input:" & varDateiname)
'Importiert gesamten Bereich:
For Each wks In ThisWorkbook.Sheets
If wks.[B1] "" Then
Set rng = wksDaten.Columns("A").Find(What:=wks.[B1], LookIn:=xlValues, _
LookAt:=xlWhole)
If Not rng Is Nothing Then
wks.[C1] = rng.Offset(0, 1)
End If
End If
Next
wkbDaten.Close
'Fehler bereich ist noch nicht fertig, funktioniert aber irgendwie auch nicht so wie geplant... _
bin noch relativ neu in excel
FEHLER:
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
'wartet eine Sekunde
Application.Wait (Now + TimeValue("0:00:01"))
Windows(varDateiname).Activate
Range("A2:M51").Select
Selection.Copy
Windows(Dateinameexcel).Activate
Sheets("SAP Data").Select
Range("B3:BD507").Select
'Application.CutCopyMode = False
'löscht definierten Bereich
Selection.ClearContents
ActiveWindow.SmallScroll Down:=-18
Range("B3").Select
Windows(varDateiname).Activate
ActiveWindow.SmallScroll Down:=-24
Selection.Copy
Windows(Dateinameexcel).Activate
ActiveSheet.Paste
Range("B3").Select
Application.CutCopyMode = False
Windows(varDateiname).Close saveChanges = False
End With
End Sub