AW: Umrechnung in Binär
06.10.2022 17:20:39
UweD
Hier jetzt noch die richtige Logik für die Nachkommastellen.
Da es meist eine Periode gibt, habe ich die Stellen der Ausgabe begrenzt
Option Explicit
Function BBin(Wert As Double, Stellen As Integer)
Dim Anz As Integer
Select Case True
Case Left(Wert, 2) = "0x"
Wert = Mid(Wert, 3)
BBin = dhHexToBinary(CStr(Wert))
Case Else
Wert = Replace(Wert, "_", "")
Wert = Replace(Wert, ".", ",")
Wert = Trim(Replace(Wert, "Ghz", ""))
If CDbl(Int(Wert)) CDbl(Wert) Then
BBin = Dec2bin(Wert) & "," & nDec2bin(Wert, Stellen)
Else
BBin = Dec2bin(Wert)
End If
End Select
If Len(BBin) 0 Then Dec2bin = Dec2bin(lngZahl \ 2) & IIf(lngZahl Mod 2, "1", "0")
End Function
Function dhHexToBinary(strNumber As String) As String
Dim strTemp As String
Dim strOut As String
Dim i As Integer
For i = 1 To Len(strNumber)
Select Case UCase(Mid(strNumber, i, 1))
Case "0" To "9", "A" To "F"
strTemp = Application.WorksheetFunction.Hex2Bin(UCase(Mid(strNumber, i, 1)), 4)
Case Else
strTemp = ""
End Select
strOut = strOut & strTemp
Next i
'führende Nullen entfernen
If CDbl(strOut) = 0 Then
dhHexToBinary = "0"
Else
dhHexToBinary = Mid(strOut, InStr(strOut, "1"))
End If
End Function
Function nDec2bin(ByVal dblZahl As Double, iAnz As Integer) As String
Dim i As Integer
Dim strOut As String, tmp As Boolean
Do Until i = iAnz And tmp
dblZahl = dblZahl - Int(dblZahl)
If dblZahl * 2 >= 1 Then
strOut = strOut & "1"
tmp = True
Else
strOut = strOut & "0"
End If
i = i + 1
dblZahl = dblZahl * 2
Loop
nDec2bin = strOut
End Function
Der Aufruf ändert sich daher um die Eingabe der Stellen
| A | B |
1 | Defaultwert | Wert in Binär |
2 | 600 | 1001011000 |
3 | 60 | 111100 |
4 | 120 | 1111000 |
5 | _2.4 Ghz | 10,011001 |
6 | _5 Ghz | 000101 |
7 | 0x0 | 000000 |
8 | 0x00 | 000000 |
9 | 0x0000000000000000000000000 | 000000 |
10 | 0x4A38 | 100101000111000 |
11 | 0x10 | 010000 |
12 | 0x362D | 11011000101101 |
13 | 0x03E8 | 1111101000 |
14 | 0xFFFFFFFFFFF | 11111111111111111111111111111111111111111111 |
15 | 0x1 | 000001 |
LG UweD