Verbesserte Round-Funktion in VB Eine verbesserte Round-Funktion, die einen Wert korrekt rundet - egal, ob Punkt oder Komma als Nachkomma-Trennzeichen angeben ist.
Autor:   Ivan Lucic	Bewertung:     [ Jetzt bewerten ]	Views:  16.554
ohne Homepage	System:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11	Beispielprojekt auf CD

Geben Sie hier Ihre persönliche Bewertung ab! Anzahl Bewertungen bisher: 42 Bewertung insgesamt: gut Durchschnittliche Bewertung: 3.8 von 5 Sternen

sehr gut     gut     nützlich     mittelmäßig     mangelhaft

Die VB Round-Funktion hat eigentlich keinen Fehler, sondern verwendet eine andere Rundungsmöglichkeit und alle anderen Funktionen, die ich im Internet gefunden hatte waren nicht geeignet. Ich brauchte eine Funktion die stur immer bei einer 5 aufrundet und drunter abrundet - und zwar egal, ob als Dezimaltrennzeichen ein Komma oder ein Punkt verwendet wird. Hab' mir dann gedacht, schreib ich selber schnell, auch 2 Übergabeparameter (bei mir als String - beliebig lange Zahlen), das wäre einmal die zu rundende Zahl und zum anderen die Anzahl der Stellen, auf die gerundet werden soll. Das Ergebnis gibt die Funktion dann wieder als String zurück.

Die Funktion ist von der Spracheinstellung unabhängig, also egal ob sie eine "Amerikanische" oder "Deutsche" Kommazahl übergeben. Die Zahl wird immer korrekt interpretiert und mit dem gleichen Kommazeichen zurückgegeben. Dabei sind auch Zahlen mit 1000-er Trennzeichen erlaubt (wichtig beim Parsen).

Die Kommentare hab ich in englisch geschrieben, damit sie auch jeder verstehen kann.

Private Function Round(numToRnd As String, _
  rndToDec As String) As String
 
  Dim strDecSymbol As String
  Dim tmpNumToRnd As String
  Dim tmpStr As String
  Dim i As Integer
  Dim digBefCom As Integer
  Dim digAftCom As Integer
  Dim cntCom As Integer
  Dim cntPnt As Integer
  Dim tmpRndToDec As Integer
  Dim isMinus As Boolean
 
  ' check if the strings are empty and check if
  ' the "RoundTo" variable is numeric
  If Len(numToRnd) > 0 And Len(rndToDec) > 0 And _
    IsNumeric(rndToDec) = True Then
 
    ' use temp variable
    tmpRndToDec = rndToDec
 
    ' can't round to "minus", so round to 0
    If tmpRndToDec < 0 Then tmpRndToDec = 0
 
    ' use temp variable
    tmpNumToRnd = numToRnd
 
    ' check if it is a negative number
    isMinus = False
    If Left$(tmpNumToRnd, 1) = "-" Then
      isMinus = True
      ' converts the number to positive
      tmpNumToRnd = Right$(tmpNumToRnd, Len(tmpNumToRnd) - 1)
    End If
 
    ' check if is numeric
    If IsNumeric(Replace(Replace(tmpNumToRnd, ".", ""), _
      ",", "")) = False Then
 
      ' the number is not numeric, return value is 0
      ' exit function
      Round = 0
      Exit Function
    End If
 
    ' set the actual decimal seperator to ""
    strDecSymbol = ""
 
    ' set count of the seperators to 0
    cntCom = 0
    cntPnt = 0
 
    ' count comas
    For i = 1 To Len(tmpNumToRnd)
      If Mid$(tmpNumToRnd, i, 1) = "," Then
        cntCom = cntCom + 1
      End If
    Next
 
    ' count points
    For i = 1 To Len(tmpNumToRnd)
      If Mid$(tmpNumToRnd, i, 1) = "." Then
        cntPnt = cntPnt + 1
      End If
    Next
 
    ' check the comma/point count
    If cntCom > cntPnt Then
      If cntCom = 1 Then
        ' there is only one comma, also set the
        ' actual decimal symbol to ","
        strDecSymbol = ","
      Else
        ' there are several commas, also set the
        ' actual decimal symbol to "." because
        ' in this case are commas only digit
        ' grouping symbols
        strDecSymbol = "."
      End If
      If cntPnt = 0 And cntCom > 1 Then
        ' there are no points, also delete all
        ' commas because they are only digit
        ' grouping symbols
        tmpNumToRnd = Replace(tmpNumToRnd, ",", "")
 
        ' ...and set the actual decimal symbol to nothing
        strDecSymbol = ""
      End If
 
    ElseIf cntCom < cntPnt Then
      If cntPnt = 1 Then
        ' there is only one point, also set the
        ' actual decimal symbol to "."
        strDecSymbol = "."
      Else
        ' there are several points, also set the
        ' actual decimal symbol to "," because
        ' in this case are points only digit
        ' grouping symbols
        strDecSymbol = ","
      End If
      If cntCom = 0 And cntPnt > 1 Then
        ' there are no commas, also delete all
        ' points because they are only digit
        ' grouping symbols
        tmpNumToRnd = Replace(tmpNumToRnd, ".", "")
 
        ' ...and set the actual decimal symbol
        ' to nothing
        strDecSymbol = ""
      End If
 
    ElseIf cntCom = 0 And cntPnt = 0 Then
      ' there are no symbols, also set the actual
      ' decimal symbol to nothing
      strDecSymbol = ""
 
    ElseIf cntCom = cntPnt Then
      ' there are same number points and commas, also
      ' search the last symbol and set
      ' this one as actual decimal symbol
      For i = Len(tmpNumToRnd) To 1 Step -1
        tmpStr = Mid$(tmpNumToRnd, i, 1)
        If tmpStr = "." Then
          strDecSymbol = "."
          Exit For
        ElseIf tmpStr = "," Then
          strDecSymbol = ","
          Exit For
        End If
      Next
 
      ' not important but cleanly, set the
      ' temp string to ""
      tmpStr = ""
    End If
 
    ' when exists, delete digit grouping symbols
    If strDecSymbol = "," Then
      tmpNumToRnd = Replace(tmpNumToRnd, ".", "")
    ElseIf strDecSymbol = "." Then
      tmpNumToRnd = Replace(tmpNumToRnd, ",", "")
    End If
 
    ' delete zeros on the begin and on the end
    Do While Left$(tmpNumToRnd, 1) = "0"
      tmpNumToRnd = Right$(tmpNumToRnd, Len(tmpNumToRnd) - 1)
    Loop
    If Len(strDecSymbol) > 0 Then
      Do While Right$(tmpNumToRnd, 1) = "0"
        tmpNumToRnd = Left$(tmpNumToRnd, Len(tmpNumToRnd) - 1)
      Loop
    End If
 
    ' set the string to 0 in case when all digits were
    ' zero's and deleted by the last loop
    If Len(tmpNumToRnd) = 0 Then
      tmpNumToRnd = 0
 
      ' return the result to the function and exit function
      Round = tmpNumToRnd
      Exit Function
    End If
 
    If strDecSymbol = "" Then
      ' there is no decimal symbol, also it's not
      ' necessary to edit the string also first
      ' check if the input was negative
      If isMinus = True And tmpNumToRnd > 0 Then
        ' yes, also add a minus
        tmpNumToRnd = "-" & tmpNumToRnd
      End If
 
      ' return the result to the function exit function
      Round = tmpNumToRnd
      Exit Function
    End If
 
    ' count digits before and after decimal symbol
    For i = 1 To Len(tmpNumToRnd)
      If Mid$(tmpNumToRnd, i, 1) = strDecSymbol Then
        digBefCom = i - 1
        Exit For
      End If
    Next
 
    digAftCom = Len(tmpNumToRnd) - digBefCom - 1
 
    ' when there's nothing before and after the
    ' decimal symbol then set the string to 0
    If digBefCom = 0 And digAftCom = 0 Then
      tmpNumToRnd = 0
    End If
 
    ' delete decimal symbol if on the last position
    Do While Right$(tmpNumToRnd, 1) = "," Or _
      Right$(tmpNumToRnd, 1) = "."
 
      tmpNumToRnd = Left$(tmpNumToRnd, Len(tmpNumToRnd) - 1)
    Loop
 
    ' there are more digits after the decimal symbol
    ' as the wanted digits, so start rounding
    If digAftCom > tmpRndToDec Then
      ' remove decimal symbol(s)
      tmpNumToRnd = Replace(tmpNumToRnd, strDecSymbol, "")
 
      ' remove unnecessary digits, leave only one more
      ' as wanted, temporary necessary
      tmpNumToRnd = Left$(tmpNumToRnd, _
        digBefCom + tmpRndToDec + 1)
 
      ' check if the last digit is greater then 4
      If Right$(tmpNumToRnd, 1) > 4 Then
        ' ...yes, also cut it (last digit)
        tmpNumToRnd = Left$(tmpNumToRnd, Len(tmpNumToRnd) - 1)
 
        ' ...and check the next
        For i = Len(tmpNumToRnd) To 1 Step -1
          ' check if the actual digit is 9
          If Mid$(tmpNumToRnd, i, 1) = 9 Then
            ' yes, also set it to 0 and go to the next digit
            tmpNumToRnd = Left$(tmpNumToRnd, i - 1) & "0" & _
              Right$(tmpNumToRnd, Len(tmpNumToRnd) - i)
          Else
            ' no, only increase it and exit loop
            tmpNumToRnd = Left$(tmpNumToRnd, i - 1) & _
              Mid$(tmpNumToRnd, i, 1) + 1 & _
              Right$(tmpNumToRnd, Len(tmpNumToRnd) - i)
            Exit For
          End If
        Next
 
        ' check if all digits are 9
        If i = 0 Then
          ' yes (loop runs to the string start), also add a 1
          tmpNumToRnd = "1" & tmpNumToRnd
 
          ' increase the number of the digits before
          ' decimal symbol
          digBefCom = digBefCom + 1
        End If
 
      Else
        ' no, the last digit is less then 5, also
        ' only cut the last digit
        tmpNumToRnd = Left$(tmpNumToRnd, Len(tmpNumToRnd) - 1)
      End If
 
      ' if there was only one digit and was cutted,
      ' then ser the string to 0
      If Len(tmpNumToRnd) = 0 Then tmpNumToRnd = 0
 
      ' add digit symbol
      If tmpRndToDec = 0 Then
        ' number should not be rounded, then do nothing
        tmpNumToRnd = tmpNumToRnd
      ElseIf digBefCom = 0 Then
        ' there was no digits before decimal symbol,
        ' also add a zero and decimal symbol
        tmpNumToRnd = 0 & strDecSymbol & tmpNumToRnd
      Else
        ' set the decimal symbol to the old position
        tmpNumToRnd = Left$(tmpNumToRnd, digBefCom) & _
          strDecSymbol & Right$(tmpNumToRnd, tmpRndToDec)
      End If
 
    ElseIf digAftCom <= tmpRndToDec Then
      ' not necessary to round, so add a zero when the
      ' decimal symbol is on the first position
      If Left$(tmpNumToRnd, 1) = strDecSymbol Then
        tmpNumToRnd = "0" & tmpNumToRnd
      End If
 
      ' check if the requested number of digits are
      ' grater as 0
      If tmpRndToDec > 0 Then
        ' yes, also add a decimal symbol at the
        ' end of the string when it is an integer
        If InStr(tmpNumToRnd, strDecSymbol) = 0 Then
          tmpNumToRnd = tmpNumToRnd & strDecSymbol
        End If
      End If
 
      ' add needed zero's to the end of the string
      For i = 1 To tmpRndToDec - digAftCom
        tmpNumToRnd = tmpNumToRnd & "0"
      Next
    End If
 
    ' check if the input was negative
    If isMinus = True And tmpNumToRnd > 0 Then
      ' yes, also add a minus
      tmpNumToRnd = "-" & tmpNumToRnd
    End If
 
    ' return the result to the function
    Round = tmpNumToRnd
 
  Else
    ' the parameter strings are not legal
    Round = 0
  End If
End Function