In VBA there are no bitwise operators, those similar to “” operators in C++ and Visual Basic. Do this mean we can’t do bit shift operations?.
Following this post from Excely, we can replicate bitwise shift operators with multiplying or dividing by the appropriate power of 2.
The original post code was far from optimized and did not behave well in several possible situations we can deal with. The code presented here have some amedments, beeing the main to have a buffer with the shifters to optimize the operations, and some checkings in the code just to get not trapped in overflow errors.
Option Explicit
Private aShifter() As Long ' Buffer for the shift operations
Private Function fBitwiser() As Boolean
' Compute the shifters and store in buffer
Dim lgShift As Long
ReDim aShifter(0 To 30) ' overflow for 2^31 and 2^32
aShifter(0) = 1 '2^0
For lgShift = 1 To 30
aShifter(lgShift) = aShifter(lgShift - 1) * 2 '2^lgShift
Next lgShift
End Function
Public Sub sBitwiseTest()
Dim Value As Long
Dim strHex1 As String
Dim strHex2 As String
Value = &H90000000
strHex1 = "&H" & Hex(shr(Value, 1))
strHex2 = "&H" & Hex(shl(strHex1, 1))
End Sub
Public Function shr(ByVal Value As Long, _
ByVal shift As Byte) As Long
' Right shifting is equal to dividing by 2^shift
' Bitwise Right Shift Function
Dim bSgn As Boolean
If Not (Not aShifter()) Then Else Call fBitwiser
If shift > 30 Then GoTo ErrControl
If Value 0) Then Value = Value - 1
shr = Not Value
Else
shr = Value
End If
Else
Value = 0
End If
Exit Function
ErrControl:
Dim lgRetVal As Long
lgRetVal = VBA.MsgBox("Can not operate on 32 bits", vbExclamation + vbOKOnly)
End Function
Public Function shl(ByVal Value As Long, _
ByVal shift As Byte) As Long
' Left shifting is equal to multiplying by 2^Shift.
' Bitwise Left Shift Function
If Not (Not aShifter()) Then Else Call fBitwiser
shl = Value
If shift > 0 Then
Dim i As Long
Dim m As Long
If Value < aShifter(30 - shift) Then
Value = Value * aShifter(shift)
Else
' To avoid an overflow error we'd use small trick:
For i = 1 To Shift
m = Value And &H40000000 ' save 30th bit
Value = Value And &H3FFFFFFF ' clear 30th and 31st bits
Value = Value * 2 ' multiply by 2
If m 0 Then Value = Value Or &H80000000 ' set 31st bit
Next i
End If
shl = Value
End If
End Function
Public Function DecToBin(ByVal lngDec As Long) As String
' Decimal-to-Binary function that converts a Long Integer value
' (max value range -2^31 to 2^31 or -2147483648 to 2147483647)
' to binary number represented by a string:
' Sample Results:
'-----------------------------
' Print DecToBin(32768)
' 00000000000000001000000000000000
' Print DecToBin(32769)
' 00000000000000001000000000000001
' Print DecToBin(2 ^ 31 - 1)
' 01111111111111111111111111111111
' Print DecToBin(2147483647)
' 01111111111111111111111111111111
' Print DecToBin(-2 ^ 31)
' 10000000000000000000000000000000
' Print DecToBin(-2147483648#)
' 10000000000000000000000000000000
' Print DecToBin(2 ^ 31)
' Overflow error
Const MAXLEN = 30
Dim strBin As String
Dim n As Long
If Not (Not aShifter()) Then Else Call fBitwiser
If lngDec < 0 Then strBin = "1" Else strBin = "0"
For n = MAXLEN To 0 Step -1
If (lngDec And aShifter(n)) Then
strBin = strBin & "1"
Else
strBin = strBin & "0"
End If
Next
DecToBin = strBin
End Function
[/sourcecode]