Many engineering applications could benefit from a much
larger range for these functions. Support up to at least 2^64
(but why don't you shoot for 2^128 to give yourselves some
margin) would be nice for future versions, including all
permutations of DEC <--> HEX, DEC <-->BIN, and HEX <--> BIN.
Across the years, I have posted several versions of the following routines.
They all have the in common that they can handle huge argument values (see
the comments above the function declarations for the various limits).
Because the have been developed at widely varying different times, there is
no real consistency to error handling (some have it, some don't... those
that do may differ in the method). Each of these functions should be able to
be used as a UDF in needed. Whether being used as a UDF or a support
function for other VB code, note the need to pass large numeric value as
strings and the need to receive large numeric return values as strings so as
to avoid conversions into scientific notation. Okay, e the functions are
listed underneath my signature
Rick Rothstein (MVP - Excel)
' The DecimalIn argument is limited to 79228162514264337593543950266
' (approximately 96-bits) - large numerical values must be entered
' as a String value to prevent conversion to scientific notation.
Function DecToBin(ByVal DecimalIn As Variant, _
Optional NumberOfBits As Variant) _
As String
DecToBin = ""
DecimalIn = CDec(DecimalIn)
Do While DecimalIn <> 0
DecToBin = Trim$(Str$(DecimalIn - 2 * Int(DecimalIn / 2))) & DecToBin
DecimalIn = Int(DecimalIn / 2)
Loop
If Not IsMissing(NumberOfBits) Then
If Len(DecToBin) > NumberOfBits Then
DecToBin = "Error - Number too large for bit size"
Else
DecToBin = Right$(String$(NumberOfBits, "0") & _
DecToBin, NumberOfBits)
End If
End If
End Function
' BinaryString argument can be a maximum of 96 digits (either 0's or 1's)
Function BinToDec(BinaryString As String) As Variant
Dim X As Integer
Const TwoToThe48 As Variant = 281474976710656#
For X = 0 To Len(BinaryString) - 1
If X > 48 Then
BinToDec = CDec(BinToDec) + Val(Mid(BinaryString, Len(BinaryString) -
X, 1)) * TwoToThe48 * CDec(2 ^ (X - 48))
Else
BinToDec = CDec(BinToDec) + Val(Mid(BinaryString, Len(BinaryString) -
X, 1)) * CDec(2 ^ X)
End If
Next
If Len(BinToDec) > 10 Then BinToDec = CStr(BinToDec)
End Function
' DecimalIn argument limited to 4951760157141520569681456883
' large numerical values must be entered as a String value
' to prevent conversion to scientific notation.
Function DecToHex(ByVal DecimalIn As Variant) As String
Dim X As Integer
Dim BinaryString As String
Const BinValues = "*0000*0001*0010*0011*0100*0101*0110*0111" & _
"*1000*1001*1010*1011*1100*1101*1110*1111*"
Const HexValues = "0123456789ABCDEF"
Const MaxNumOfBits As Long = 96
BinaryString = ""
DecimalIn = Int(CDec(DecimalIn))
Do While DecimalIn <> 0
BinaryString = Trim$(Str$(DecimalIn - 2 * Int(DecimalIn / 2))) &
BinaryString
DecimalIn = Int(DecimalIn / 2)
Loop
BinaryString = String$((4 - Len(BinaryString) Mod 4) Mod 4, "0") &
BinaryString
For X = 1 To Len(BinaryString) - 3 Step 4
DecToHex = DecToHex & Mid$(HexValues, (4 + InStr(BinValues, "*" & _
Mid$(BinaryString, X, 4) & "*")) \ 5, 1)
Next
End Function
' HexString argument can be a maximum of 23-Hex digits
Function HexToDec(ByVal HexString As String) As Variant
Dim X As Integer
Dim BinStr As String
Const BinValues = "00000001001000110100010101100111" & _
"10001001101010111100110111101111"
If Left$(HexString, 2) Like "&[hH]" Then
HexString = Mid$(HexString, 3)
End If
If Len(HexString) <= 23 Then
For X = 1 To Len(HexString)
BinStr = BinStr & Mid$(BinValues, 4 * Val("&h" & _
Mid$(HexString, X, 1)) + 1, 4)
Next
HexToDec = CDec(0)
For X = 0 To Len(BinStr) - 1
HexToDec = HexToDec + Val(Mid(BinStr, Len(BinStr) - X, 1)) * 2 ^ X
Next
Else
' Number is too big, handle error here
End If
End Function
' HexString argument limited only by the maximum length of a VB String
Function HexToBin(HexString As String, Optional WithBlanks As Boolean) As
Variant
Dim X As Integer
Const BinValues = "00000001001000110100010101100111" & _
"10001001101010111100110111101111"
For X = 1 To Len(HexString)
HexToBin = HexToBin & Mid$(BinValues, 4 * Val("&h" & Mid$(HexString, X,
1)) + 1, 4)
If WithBlanks Then HexToBin = HexToBin & " "
Next
End Function
' BinaryString argument limited only by the maximum length of a VB String
Function BinToHex(ByVal BinaryString As String) As String
Dim X As Integer
Const BinValues = "*0000*0001*0010*0011*0100*0101*0110*0111" & _
"*1000*1001*1010*1011*1100*1101*1110*1111*"
Const HexValues = "0123456789ABCDEF"
If BinaryString Like "*[!01]*" Then
BinToHex = "Error - Argument not a binary string"
Else
BinaryString = String$((4 - Len(BinaryString) _
Mod 4) Mod 4, "0") & BinaryString
For X = 1 To Len(BinaryString) - 3 Step 4
BinToHex = BinToHex & Mid$(HexValues, _
(4 + InStr(BinValues, "*" & _
Mid$(BinaryString, X, 4) & "*")) \ 5, 1)
Next
End If
End Function