Ergänzung zu einer Funktion
11.10.2022 15:13:27
Kai
mir hat der UweD mit einer super Funktion schon geholfen. ich benötige eine kleine Ergänzung.
Die Ergänzung wäre, wenn die lngZahl = 0 ist, das dann auch eine 0 geschrieben wird. Ich habe selber versucht an der Syntax was zu ändern, leider komme ich nicht zum gewünschten Ziel
Function BBin(Wert)
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) & ",++" 'RestDec2bin(CStr(Wert))
Else
BBin = Dec2bin(Wert)
End If
End Select
If Len(BBin)
Function Dec2bin(ByVal lngZahl As Long) As String
If lngZahl > 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
>
Vielen Dank im Voraus
Gruß Kai