German BCD nach Double

hogiebaer said:

habs gelöst

Click to expand...

Sub bcdtozahl(source As String)

Dim t As Byte
Dim bw As Byte
Dim data,neueziffer As String
Dim Ziffer1,Ziffer2 As Int
Dim ausgabe As Double
Dim azz As Byte

azz=source.Length

If azz=4 Then
data=Mid(source,4,1) & Mid(source,3,1) & Mid(source,2,1) & Mid(source,1,1)
End If

If azz=2 Then
data=Mid(source,2,1) & Mid(source,1,1)
End If


neueziffer =""

For t = 1 To azz
bw=Asc(Mid(data,t,1))
Ziffer1=0 : Ziffer2=0
'Ziffer 1
If (Bit.And(bw,1)) = 1 Then Ziffer1 = Ziffer1 + 1
If (Bit.And(bw,2)) = 2 Then Ziffer1 = Ziffer1 + 2
If (Bit.And(bw,4)) = 4 Then Ziffer1 = Ziffer1 + 4
If (Bit.And(bw,8)) = 8 Then Ziffer1 = Ziffer1 + 8
'Ziffer 2
If (Bit.And(bw,16)) = 16 Then Ziffer2 = Ziffer2 + 1
If (Bit.And(bw,32)) = 32 Then Ziffer2 = Ziffer2 + 2
If (Bit.And(bw,64)) = 64 Then Ziffer2 = Ziffer2 + 4
If (Bit.And(bw,128)) =128 Then Ziffer2 = Ziffer2 + 8
neueziffer=neueziffer & Ziffer2 & Ziffer1
Next

ausgabe=neueziffer
If azz=4 Then ausgabe=ausgabe/100
Return ausgabe

End Sub

Click to expand...