Example 1: excel vba string to bits
'VBA function to convert text to a binary string representation:
Public Function TextToBinaryString$(s$)
Dim c&, i&, lo&, bin$(0 To 255), d() As Byte
Const ZEROS$ = "00000000"
For c = 0 To 255
bin(c) = ZEROS
If c And 1& Then MidB$(bin(c), 15) = "1"
If c And 2& Then MidB$(bin(c), 13) = "1"
If c And 4& Then MidB$(bin(c), 11) = "1"
If c And 8& Then MidB$(bin(c), 9) = "1"
If c And 16& Then MidB$(bin(c), 7) = "1"
If c And 32& Then MidB$(bin(c), 5) = "1"
If c And 64& Then MidB$(bin(c), 3) = "1"
If c And 128& Then MidB$(bin(c), 1) = "1"
Next
d = s
lo = 1
TextToBinaryString = Space$(LenB(s) * 8)
For i = 0 To LenB(s) - 1 Step 2
Mid$(TextToBinaryString, lo) = bin(d(i + 1))
Mid$(TextToBinaryString, lo + 8) = bin(d(i))
lo = lo + 16
Next
End Function
'------------------------------------------------------------------------------
MsgBox TextToBinaryString("Hi") '<--displays: 00000000010010000000000001101001
Example 2: excel vba bit mask
'VBA function to create a bitmask in a Long Integer:
Function BitMask&(ParamArray a())
Dim i&, n&, m
For i = 0 To UBound(a)
If i > 31 Then Exit Function
m = a(i)
If m <> 0 Then
If Len(m) Then
BitMask = BitMask Or Abs(m) * 2 ^ i
End If
End If
Next
End Function
'-----------------------------------------------------------------------------
Dim mask&
mask = BitMask(1, 0, 0, 0, 1)
MsgBox mask '<--displays: 17 (00000000000000000000000000010001)
mask = BitMask(False, True, True)
MsgBox mask '<--displays: 6 (00000000000000000000000000000110)
'-----------------------------------------------------------------------------
'The above function is fast. But for the fastest possible native code,
'exponentiation (slow) can be optimized, by a lookup table. The following
'function uses the ShiftLeft() function, which is highly optimized. It is
'literally a hundred times faster:
Function BitMask&(ParamArray a())
Dim i&, n&, m
For i = 0 To UBound(a)
If i > 31 Then Exit Function
m = a(i)
If m <> 0 Then
If Len(m) Then
BitMask = BitMask Or ShiftLeft(Abs(m), i)
End If
End If
Next
End Function
Function ShiftLeft&(ByVal n&, Optional ByVal shifts& = 1)
Dim d&
Select Case shifts
Case 1: d = 2& * (n And 1073741823): If n And 1073741824 Then d = d Or &H80000000
Case 2: d = 4& * (n And 536870911): If n And 536870912 Then d = d Or &H80000000
Case 3: d = 8& * (n And 268435455): If n And 268435456 Then d = d Or &H80000000
Case 4: d = 16& * (n And 134217727): If n And 134217728 Then d = d Or &H80000000
Case 5: d = 32& * (n And 67108863): If n And 67108864 Then d = d Or &H80000000
Case 6: d = 64& * (n And 33554431): If n And 33554432 Then d = d Or &H80000000
Case 7: d = 128& * (n And 16777215): If n And 16777216 Then d = d Or &H80000000
Case 8: d = 256& * (n And 8388607): If n And 8388608 Then d = d Or &H80000000
Case 9: d = 512& * (n And 4194303): If n And 4194304 Then d = d Or &H80000000
Case 10: d = 1024& * (n And 2097151): If n And 2097152 Then d = d Or &H80000000
Case 11: d = 2048& * (n And 1048575): If n And 1048576 Then d = d Or &H80000000
Case 12: d = 4096& * (n And 524287): If n And 524288 Then d = d Or &H80000000
Case 13: d = 8192& * (n And 262143): If n And 262144 Then d = d Or &H80000000
Case 14: d = 16384& * (n And 131071): If n And 131072 Then d = d Or &H80000000
Case 15: d = 32768 * (n And 65535): If n And 65536 Then d = d Or &H80000000
Case 16: d = 65536 * (n And 32767&): If n And 32768 Then d = d Or &H80000000
Case 17: d = 131072 * (n And 16383&): If n And 16384& Then d = d Or &H80000000
Case 18: d = 262144 * (n And 8191&): If n And 8192& Then d = d Or &H80000000
Case 19: d = 524288 * (n And 4095&): If n And 4096& Then d = d Or &H80000000
Case 20: d = 1048576 * (n And 2047&): If n And 2048& Then d = d Or &H80000000
Case 21: d = 2097152 * (n And 1023&): If n And 1024& Then d = d Or &H80000000
Case 22: d = 4194304 * (n And 511&): If n And 512& Then d = d Or &H80000000
Case 23: d = 8388608 * (n And 255&): If n And 256& Then d = d Or &H80000000
Case 24: d = 16777216 * (n And 127&): If n And 128& Then d = d Or &H80000000
Case 25: d = 33554432 * (n And 63&): If n And 64& Then d = d Or &H80000000
Case 26: d = 67108864 * (n And 31&): If n And 32& Then d = d Or &H80000000
Case 27: d = 134217728 * (n And 15&): If n And 16& Then d = d Or &H80000000
Case 28: d = 268435456 * (n And 7&): If n And 8& Then d = d Or &H80000000
Case 29: d = 536870912 * (n And 3&): If n And 4& Then d = d Or &H80000000
Case 30: d = 1073741824 * (n And 1&): If n And 2& Then d = d Or &H80000000
Case 31: If n And &H1& Then d = &H80000000 Else d = &H0&
Case 0: d = n
End Select
ShiftLeft = d
End Function
Example 3: excel vba binary from byte value
Public Function ByteToBits$(ByVal n&)
ByteToBits = "00000000"
If n And 1 Then MidB$(ByteToBits, 15) = "1"
If n And 2 Then MidB$(ByteToBits, 13) = "1"
If n And 4 Then MidB$(ByteToBits, 11) = "1"
If n And 8 Then MidB$(ByteToBits, 9) = "1"
If n And 16 Then MidB$(ByteToBits, 7) = "1"
If n And 32 Then MidB$(ByteToBits, 5) = "1"
If n And 64 Then MidB$(ByteToBits, 3) = "1"
If n And 128 Then MidB$(ByteToBits, 1) = "1"
End Function
'------------------------------------------------------------------------------
MsgBox ByteToBits(0) '<--displays: 00000000
MsgBox ByteToBits(170) '<--displays: 10101010
MsgBox ByteToBits(255) '<--displays: 11111111
Example 4: vba bits to byte
'Extremely fast VBA function to convert a binary string to a Byte:
Function BitsToByte(bits$) As Byte
Dim i&
Static b() As Byte
If LenB(bits) > 16 Then Exit Function
If LenB(bits) = 16 Then
b = bits
Else
b = String$(8 - Len(bits), "0") & bits
End If
For i = 0 To 14 Step 2
BitsToByte = 2 * BitsToByte Or (b(i) Xor 48)
Next
End Function
'Example:
MsgBox BitsToByte("00001100") '<--displays: 12
MsgBox BitsToByte("10000001") '<--displays: 129
'
'
'