Nachkommastellen werden nicht korrekt ausgegeben

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub HP_erstellen() ' liest die variablen Daten eines HP aus dem jeweiligen Register "HP_Datenbank" und ' überträgt sie in das Register "HP" 'Call aufraeumen Application.ScreenUpdating = False Dim hp_daten_pos(300) As String ' enthält die Feldnamen Dim hp_daten_hoehe(300) As Integer ' 0: wenn hpdaten(i)="" dann Zeilenhöhe = 0, 1: keine _ Aktion Dim hp_daten(300) As String ' enthält die Feldinhalte Dim register As String ' Namen des aktiven Registers bestimmen register = ActiveSheet.name Call ZeileSpalteBestimmen(ze, sp) If register = "HP_Datenbank" And ze >= 5 Then For ii = 1 To 300 hp_daten_pos(ii) = Cells(3, ii) hp_daten_hoehe(ii) = Cells(4, ii) hp_daten(ii) = Cells(ze, ii) Next ii Sheets("HP").Select For ii = 1 To 300 If hp_daten_pos(ii) "" Then Let Err = 0 On Error Resume Next Range(hp_daten_pos(ii)).Select If Err = 1004 Then MsgBox "Das Feld " & hp_daten_pos(ii) & " existiert nicht!" On Error GoTo 0 Range(hp_daten_pos(ii)).Select ' wenn keine Daten und Höhe = 0, dann Zeilenhöhe auf 0 setzen If hp_daten(ii) = "" And hp_daten_hoehe(ii) = 0 Then ActiveCell.RowHeight = 0 ' wenn , dann Zeilenhöhe auf 0 setzen ElseIf hp_daten(ii) = "" Then ActiveCell.RowHeight = 0 ' Seitenumbruch einfügen: = PageBreak ElseIf hp_daten(ii) = "" Then Call ZeileSpalteBestimmen(ze2, sp2) Rows(ze2).Select ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell Else ActiveCell.Select If Left(hp_daten(ii), 6) = "" Then hp_daten(ii) = Right(hp_daten(ii), Len(hp_daten(ii)) - 6) ActiveCell.FormulaLocal = hp_daten(ii) Else ActiveCell.Value = hp_daten(ii) End If End If End If Next ii SendKeys "(^{home})", True Cells(3, 2).Select End If 'Call FormelnErsetzen Application.ScreenUpdating = True End Sub

Hallo Ralf,
leider streicht er hier in der Ansicht einiges durch,
das ist natürlich keine Absicht.
Ich habe überhaupt keine Ahnung von Makros.
Und wie geschrieben, das Phänomen tritt nicht immer auf.
Erst ab 3 Nachkommastellen oder wenn eine Null vor dem Komma steht wird falsch umgewandelt.
---------------------------
hier ist der Code:


Sub HP_erstellen()
' liest die variablen Daten eines HP aus dem jeweiligen Register "HP_Datenbank" und
' überträgt sie in das Register "HP"
'Call aufraeumen
Application.ScreenUpdating = False
Dim hp_daten_pos(300) As String     ' enthält die Feldnamen
Dim hp_daten_hoehe(300) As Integer  ' 0: wenn hpdaten(i)="" dann Zeilenhöhe = 0, 1: keine  _
Aktion
Dim hp_daten(300) As String         ' enthält die Feldinhalte
Dim register As String
' Namen des aktiven Registers bestimmen
register = ActiveSheet.name
Call ZeileSpalteBestimmen(ze, sp)
If register = "HP_Datenbank" And ze >= 5 Then
For ii = 1 To 300
hp_daten_pos(ii) = Cells(3, ii)
hp_daten_hoehe(ii) = Cells(4, ii)
hp_daten(ii) = Cells(ze, ii)
Next ii
Sheets("HP").Select
For ii = 1 To 300
If hp_daten_pos(ii)  "" Then
Let Err = 0
On Error Resume Next
Range(hp_daten_pos(ii)).Select
If Err = 1004 Then MsgBox "Das Feld " & hp_daten_pos(ii) & " existiert nicht!"
On Error GoTo 0
Range(hp_daten_pos(ii)).Select
' wenn keine Daten und Höhe = 0, dann Zeilenhöhe auf 0 setzen
If hp_daten(ii) = "" And hp_daten_hoehe(ii) = 0 Then
ActiveCell.RowHeight = 0
' wenn , dann Zeilenhöhe auf 0 setzen
ElseIf hp_daten(ii) = "" Then
ActiveCell.RowHeight = 0
' Seitenumbruch einfügen:  = PageBreak
ElseIf hp_daten(ii) = "" Then
Call ZeileSpalteBestimmen(ze2, sp2)
Rows(ze2).Select
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell
Else
ActiveCell.Select
If Left(hp_daten(ii), 6) = "" Then
hp_daten(ii) = Right(hp_daten(ii), Len(hp_daten(ii)) - 6)
ActiveCell.FormulaLocal = hp_daten(ii)
Else
ActiveCell.Value = hp_daten(ii)
End If
End If
End If
Next ii
SendKeys "(^{home})", True
Cells(3, 2).Select
End If
'Call FormelnErsetzen
Application.ScreenUpdating = True
End Sub

Vielen Dank und viele Grüße

…nicht beantwortet wdn, srico,
weil du wohl irgendeinen Mist gebaut hast. Ansonsten geht aus deinem dort recht seltsam dargestellten Code nicht hervor, was nun wirklich in deiner „Quell-DB“ steht?! Es kann nämlich sein, dass auf Grund der dortigen Darstellung und der Weiterbehandlung per VBA <3 Dezimalen auch als solche erkannt wdn, bei >3 Dezimalen aber der DezimalTrenner als TausenderTrenner → US-Engl Komma, MS-Deutsch-Standard Pkt. Dazu kann wohl keiner eine verbindliche AW geben, weil die Original-Quell-Notation (Text- oder echte Zahl und in welcher Form) ebenso wie deine Xl-Einstellungen (auch für das Ergebnis!) allen unbekannt sind. Dein Code hilft da auch nicht viel weiter. Zu ersehen ist nur, dass du wohl TextZahlen erwartest (vorgeschaltete und deshalb eliminierte Blanks) und deshalb mittels TextFkt ggf aus einer Zahl Text machst, was zu Problemen bzgl der Unterscheidung von Dezimal- und TsderTrennZeichen führen dürfte.
Das zu checken ist dir aber hier schon empfohlen worden!
Gruß, Luc :-?

Sub HP_erstellen() ' liest die variablen Daten eines HP aus dem jeweiligen Register "HP_Datenbank" und ' überträgt sie in das Register "HP" 'Call aufraeumen Application.ScreenUpdating = False Dim hp_daten_pos(300) As String ' enthält die Feldnamen Dim hp_daten_hoehe(300) As Integer ' 0: wenn hpdaten(i)="" dann Zeilenhöhe = 0, 1: keine _ Aktion Dim hp_daten(300) As Variant ' enthält die Feldinhalte Dim register As String ' Namen des aktiven Registers bestimmen register = ActiveSheet.Name Call ZeileSpalteBestimmen(ze, sp) If register = "HP_Datenbank" And ze >= 5 Then For ii = 1 To 300 hp_daten_pos(ii) = Cells(3, ii) hp_daten_hoehe(ii) = Cells(4, ii) hp_daten(ii) = CDbl(Cells(ze, ii).text) Next ii Sheets("HP").Select For ii = 1 To 300 If hp_daten_pos(ii) "" Then Let Err = 0 On Error Resume Next Range(hp_daten_pos(ii)).Select If Err = 1004 Then MsgBox "Das Feld " & hp_daten_pos(ii) & " existiert nicht!" On Error GoTo 0 Range(hp_daten_pos(ii)).Select ' wenn keine Daten und Höhe = 0, dann Zeilenhöhe auf 0 setzen If hp_daten(ii) = "" And hp_daten_hoehe(ii) = 0 Then ActiveCell.RowHeight = 0 ' wenn , dann Zeilenhöhe auf 0 setzen ElseIf hp_daten(ii) = "" Then ActiveCell.RowHeight = 0 ' Seitenumbruch einfügen: = PageBreak ElseIf hp_daten(ii) = "" Then Call ZeileSpalteBestimmen(ze2, sp2) Rows(ze2).Select ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell Else ActiveCell.Select If Left(hp_daten(ii), 6) = "" Then hp_daten(ii) = Right(hp_daten(ii), Len(hp_daten(ii)) - 6) ActiveCell.FormulaLocal = hp_daten(ii) Else ActiveCell.Value = hp_daten(ii) End If End If End If Next ii SendKeys "(^{home})", True Cells(3, 2).Select End If 'Call FormelnErsetzen Application.ScreenUpdating = True End Sub

Beliebteste Forumthreads (12 Monate)

Nachkommastellen werden nicht korrekt ausgegeben

19
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

179 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Nachkommastellen werden nicht korrekt ausgegeben

19 Beiträge zum Forumthread Beiträge zu diesem Forumthread

179 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

19
Beiträge zum Forumthread

Beiträge zu diesem Forumthread