Noch ein's drauf
28.02.2008 13:32:10
Harald
Hallo Christian,
hier noch die Erweiterung auf k,M,g und der Weg zurück (na ja fast):
Public Function eng2dbl(text As String) As Double
' Wandelt Zahlen mit Einheit in Double Zahlen um (z.B. zum Sortieren)
' Grundversion erkennt p,n,u,m,k,M,g
' Unterscheidung m=milli, M=Mega
' 2008-02-28
' Dr. Harald Kapp
' PTD EA D AR
Dim tmp As Double
Dim Exponent As Double
Dim Nachkomma As Boolean
Dim i As Long
Dim tmpstr As String
tmp = 0
tmpstr = text
Exponent = 1
Nachkomma = False
If Len(text) = 0 Then
eng2dbl = 0 'Rückgabewert, wenn Null-Argumant
Else
Do
If IsNumeric(Left(tmpstr, 1)) Then
tmp = 10 * tmp + CDbl(Left(tmpstr, 1))
If Nachkomma Then 'Sonderbehandlung des Exponenten bei Nachkommastellen
Exponent = Exponent * 0.1
End If
Else
Select Case UCase(Left(tmpstr, 1))
Case "P"
Exponent = 0.000000000001
Case "N"
Exponent = 0.000000001
Case "U"
Exponent = 0.000001
Case "M"
If Left(tmpstr, 1) = "m" Then ' Fallunterscheidung milli und Mega
Exponent = 0.001
Else
Exponent = 1000000
End If
Case "K"
Exponent = 1000
Case "G"
Exponent = 1000000000
End Select
' nach dem Einheitenzeichen kommen die Nachkommastellen, daher muss der Exponent
' im Falle weiterer Ziffern entsprechend verringert werden
' Das wird durch dieses Flag sicher gestellt
Nachkomma = True
End If
tmpstr = Right(tmpstr, Len(tmpstr) - 1)
Loop Until Len(tmpstr) = 0
eng2dbl = tmp * Exponent
End If
End Function
'***********************************************************************************
Public Function Sci2Eng(ByVal dblRLC As Double, ByVal strUnit As String) As String
'** Author : Alexander Bell
'** Usage : Convert the value in Scientific format to Engineering, well suited
'** : for Bill Of Material (BOM). On Error returns string #ERROR"
'** PREFIXES:
' T - Tera (Multiplier 1,000,000,000,000 or 1E12)
' G - Giga (Multiplier 1,000,000,000 or 1E9)
' M - Mega (Multiplier 1,000,000 or 1E6)
' k - kilo (Multiplier 1,000)
' m - mini (Multiplier 0.001)
' u - micro (Multiplier 0.000,001 or 1E-6)
' n - nano (Multiplier 0.000,000,001 or 1E-9)
' p - pico (Multiplier 0.000,000,000,001 or 1E-12)
'** Disclaimer: This code is provided on "AS IS" basis without warranty of any kind
On Error GoTo ErrorHandle
Select Case CDec(Log(dblRLC) / Log(10))
Case Is >= 12
Sci2Eng = CStr(dblRLC / 1000000000000#) & " T"
Case Is >= 9
Sci2Eng = CStr(dblRLC / 1000000000#) & " G"
Case Is >= 6
Sci2Eng = CStr(dblRLC / 1000000#) & " M"
Case Is >= 3
Sci2Eng = CStr(dblRLC / 1000#) & " k"
Case Is >= 0
Sci2Eng = CStr(dblRLC) & " "
Case Is >= -3
Sci2Eng = CStr(dblRLC * 1000#) & " m"
Case Is >= -6
Sci2Eng = CStr(dblRLC * 1000000#) & " u"
Case Is >= -9
Sci2Eng = CStr(dblRLC * 1000000000#) & " n"
Case Else
Sci2Eng = CStr(dblRLC * 1000000000000#) & " p"
End Select
Sci2Eng = Sci2Eng & strUnit
Exit Function
ErrorHandle:
Sci2Eng = "#ERROR"
End Function
'***********************************************************************************
Die zweite Funktion habe ich selbst im Internet gefunden, sind nicht meine Lorbeeren, siehe Funktionskopf.
Gruß Harald