De zaak nog iets verder uitgewerkt.
functie 1: alphanumerics (gemengd cijfers en letters)
functie 2: enkel getallen aanvaard
functie 3: enkel positieve getallen krijgen output, anders 0
Resultaten in tabel: uiteraard staat er voor de 2 laatste functies #WAARDE, omdat de input letters bevat.
A B C D E F G
1 alphanumerics numeric positive numeric
2 1 3 1 3 1 3
3 55 liter nodig 60 55 #WAARDE! #WAARDE! #WAARDE! #WAARDE!
4 he 000,08 g 0,08 0,08 #WAARDE! #WAARDE! #WAARDE! #WAARDE!
5 14,262 ml 10 14,3 #WAARDE! #WAARDE! #WAARDE! #WAARDE!
6 26 km 30 26 #WAARDE! #WAARDE! #WAARDE! #WAARDE!
7 -0,054446 -0,05 -0,0544 -0,05 -0,0544 0 0
8 5454,123 euro 5000 5450 #WAARDE! #WAARDE! #WAARDE! #WAARDE!
9 123 100 123 100 123 100 123
10 1254 1000 1250 1000 1250 1000 1250
11 18351 20000 18400 20000 18400 20000 18400
12 1,2 1 1,2 1 1,2 1 1,2
13 1,1525456 1 1,15 1 1,15 1 1,15
14 1234567,1 1000000 1230000 1000000 1230000 1000000 1230000
Blad2
[Table-It] version 07 by Erik Van Geit
RANGE FORMULA (1st cell)
B3:C14 =SignifNrs1($A3,B$2)
D3:E14 =SignifNrs2($A3,D$2)
F3:G14 =SignifNrs3($A3,F$2)
[Table-It] version 07 by Erik Van Geit
De functies op een rijtje:
Option Explicit
Function SignifNrs1(ByRef c As String, SN As Long) As Double
'Erik Van Geit
'alphanumeric input allowed
'EXAMPLE
' A B C D E
'2 1 3 7 8
'3 aaa 55 bbb 123 60 55 55 55
'4 ccc 000,08 ddd 0,08 0,08 0,08 0,08
'5 14,262 ml 10 14,3 14,262 14,262
'6 ok -26 -30 -26 -26 -26
'7 -0,054446 -0,05 -0,0544 -0,05445 -0,054446
'8 5454,123 euro 5000 5450 5454,123 5454,123
'9 123 100 123 123 123
'10 1254 1000 1250 1254 1254
'SN 'Significant Numbers
Dim i As Long
Dim FSN As Long 'First Significant Number
Dim TempStr As String
Dim TempVal As String
Dim DS As String 'Decimal Separator
Dim RF As Long 'Round Factor
Dim DP As Long 'DS Position
Dim sign As Long
If SN < 1 Then
SignifNrs1 = 0
Exit Function
End If
sign = 1
For i = 1 To Len(c)
TempStr = Mid(c, i, 1)
If IsNumeric(TempVal & TempStr) Then
If TempVal = vbNullString And i > 1 Then
If Mid(c, i - 1, 1) = "-" Then sign = -1
End If
TempVal = TempVal & TempStr
Else
'exit after last consecutive numeric
If TempVal <> vbNullString Then Exit For
End If
Next i
TempVal = CDbl(TempVal)
DS = Application.DecimalSeparator
DP = InStr(TempVal, DS)
FSN = 1
If TempVal < 1 Then
i = 2
Do
i = i + 1
Loop While CInt(Mid(TempVal, i, 1)) = 0
FSN = i
End If
RF = IIf(DP, FSN - DP + SN - 1 - (DP > FSN), SN - Len(TempVal))
SignifNrs1 = Application.WorksheetFunction.Round(TempVal * sign, RF)
End Function
Option Explicit
Function SignifNrs2(ByRef c As String, SN As Long) As Double
'Erik Van Geit
'only numberic input
'EXAMPLE
' A F G H I
'2 1 3 7 8
'3 aaa 55 bbb 123 #VALUE! #VALUE! #VALUE! #VALUE!
'7 -0,054446 -0,05 -0,0544 -0,054446 -0,054446
'11 18351 20000 18400 18351 18351
'12 1,2 1 1,2 1,2 1,2
'13 1,1525456 1 1,15 1,152546 1,1525456
'14 1234567,1 1000000 1230000 1234567 1234567,1
'SN 'Significant Numbers
Dim i As Long
Dim FSN As Long 'First Significant Number
Dim TempVal As String
Dim DS As String 'Decimal Separator
Dim RF As Long 'Round Factor
Dim DP As Long 'DS Position
Dim sign As Long
If SN < 1 Or c = 0 Then
SignifNrs2 = 0
Exit Function
End If
TempVal = c
sign = 1
If TempVal < 0 Then
sign = -1
TempVal = CDbl(Mid(TempVal, 2, 999))
End If
DS = Application.DecimalSeparator
DP = InStr(TempVal, DS)
FSN = 1
If TempVal < 1 Then
i = 2
Do
i = i + 1
Loop While CInt(Mid(TempVal, i, 1)) = 0
FSN = i
End If
RF = IIf(DP, FSN - DP + SN - 1 - (DP > FSN), SN - Len(TempVal))
SignifNrs2 = Application.WorksheetFunction.Round(TempVal * sign, RF)
End Function
Option Explicit
Function SignifNrs3(ByRef c As String, SN As Long) As Double
'Erik Van Geit
'only positive numbers
'EXAMPLE
' A F G H I
'2 1 3 7 8
'3 aaa 55 bbb 123 #VALUE! #VALUE! #VALUE! #VALUE!
'7 -0,054446 0 0 0 0
'11 18351 20000 18400 18351 18351
'12 1,2 1 1,2 1,2 1,2
'13 1,1525456 1 1,15 1,152546 1,1525456
'14 1234567,1 1000000 1230000 1234567 1234567,1
'SN 'Significant Numbers
Dim i As Long
Dim FSN As Long 'First Significant Number
Dim TempVal As String
Dim DS As String 'Decimal Separator
Dim RF As Long 'Round Factor
Dim DP As Long 'DS Position
If SN < 1 Or c <= 0 Then
SignifNrs3 = 0
Exit Function
End If
TempVal = c
DS = Application.DecimalSeparator
DP = InStr(TempVal, DS)
FSN = 1
If TempVal < 1 Then
i = 2
Do
i = i + 1
Loop While CInt(Mid(TempVal, i, 1)) = 0
FSN = i
End If
RF = IIf(DP, FSN - DP + SN - 1 - (DP > FSN), SN - Len(TempVal))
SignifNrs3 = Application.WorksheetFunction.Round(TempVal, RF)
End Function
Ik ben er quasi zeker van dat een formule ook wel kan lukken... Als ik nog eens tijd heb...
fijn weekend!
Erik