Comment On Tourne en round()

Je ne pensais pas cela possible. Je pensais honnêtement qu'on ne pouvait pas faire pire que cette fonction d'arrondi.

Rendons hommage à Greg Fulton pour avoir trébuché sur cette méthode qui tient du génie. Pauvre, pauvre Greg.

Function RoundString(strNumber As String, noOfDPs As Integer) As String
        Dim curNoOfDPs As Integer
        Dim dpPos As Integer
        Dim i As Integer
        Dim char As String*1
        Dim result As String
        Dim done As Variant
        
        result = ""
        done = False
        
        dpPos = Instr(strNumber, ".")
        If noOfDPs >= 0 Then
                If dpPos = 0 Then
                        If noOfDPs = 0 Then
                                result = strNumber
                        Else
                                result = strNumber & "." & String(noOfDps, "0")
                        End If
                Else
                        curNoOfDPs = Len(strNumber) - dpPos
                        If curNoOfDPs = noOfDPs Then
                                result = strNumber
                        Elseif curNoOfDPs < noOfDPs Then
                                'Add trailing zeros
                                result = strNumber & String(noOfDPs - curNoOfDPs, "0")
                        Else
                                'Actually need to round
                                If noOfDPs = 0 Then
                                        char = Mid(strNumber, dpPos + 1, 1)
                                        Select Case char
                                        Case "5", "6", "7", "8", "9"
                                        'We have to round up
                                                done = False
                                                For i = dpPos - 1 To 1 Step -1
                                                        char = Mid(strNumber, i, 1)
                                                        Select Case char
                                                        Case "-", "+"
                                                                If Not done Then
                                                                        result = "1" & result
                                                                        done = True
                                                                End If
                                                                result = char & result
                                                        Case "9"
                                                                result = "0" & result
                                                        Case Else
                                                                result = (Cint(char) + 1) & result
                                                                done = True
                                                                Exit For
                                                        End Select
                                                Next i
                                                If Not done Then
                                                        result = "1" & result
                                                Else
                                                        If i > 1 Then
                                                                result = Left(strNumber, i - 1) & result
                                                        End If
                                                End If
                                        Case Else
                                        'Simply return the integer part
                                                result = Strleft(strNumber, ".")
                                        End Select
                                Else
                                        char = Mid(strNumber, dpPos + noOfDPs + 1, 1)
                                        Select Case char
                                        Case "5", "6", "7", "8", "9"
                                                'We have to round up
                                                done = False
                                                For i = dpPos + noOfDPs To 1 Step -1
                                                        char = Mid(strNumber, i, 1)
                                                        Select Case char
                                                        Case "."
                                                                result = char & result
                                                        Case "-", "+"
                                                                If Not done Then
                                                                        result = "1" & result
                                                                        done = True
                                                                End If
                                                                result = char & result
                                                        Case "9"
                                                                result = "0" & result
                                                        Case Else
                                                                result = Left(strNumber, i - 1) & (Cint(char) + 1) & result
                                                                done = True
                                                                Exit For
                                                        End Select
                                                Next i
                                                If Not done Then
                                                        result = "1" & result
                                                Else
                                                        'result = Left(strNumber, i - 1) & (Cint(char) + 1)
                                                End If
                                        Case Else
                                                'Simply return the integer part
                                                result = Left(strNumber, dpPos + noOfDPs)
                                        End Select
                                End If
                        End If
                End If
        Else
                'We're rounding to the left of the decimal places (to the nearest 10, 1000, etc)
                Dim leftOfDP As Integer
                If dpPos = 0 Then
                        leftOfDP = Len(strNumber)
                Else
                        leftOfDP = dpPos - 1
                End If
                If leftOfDP > 0 Then
                        done = True
                        For i = leftOfDP To 1 Step -1
                                If (i - leftOfDP) > (noOfDPs + 1) Then
                                        result = "0" & result
                                Elseif (i - leftOfDP) = (noOfDPs + 1) Then
                                        char = Mid(strNumber, i, 1)
                                        Select Case char
                                        Case "5", "6", "7", "8", "9"
                                                'We have to round up
                                                done = False
                                        End Select
                                        result = "0" & result
                                Else
                                        char = Mid(strNumber, i, 1)
                                        If Not done Then
                                                Select Case char
                                                Case "-", "+"
                                                        result = "1" & result
                                                        done = True
                                                        result = char & result
                                                Case "9"
                                                        result = "0" & result
                                                Case Else
                                                        result = (Cint(char) + 1) & result
                                                        done = True
                                                End Select
                                        Else
                                                result = char & result
                                        End If
                                End If
                        Next i
                        If Not done Then
                                result = "1" & result
                        End If
                        If Not (result Like "*[123456789]*") Then
                                result = "0"
                        End If
                End If
        End If
        If Mid(result, 1, 1) = "." Then
                RoundString = "0" & result
        Else
                RoundString = result
        End If
End Function