|
|
| /* Edition Française */ |
|
|
|
| /* Edition Française */ |
| « enregistrement pragmatique | Le quadritri » |
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
| « enregistrement pragmatique | Le quadritri » |
