'===========================================================
' High-Performance Bitwise Shift Functions for 32-bit Integers in VBA
' Provides logical left shift (LogicalShiftLeft), logical right shift (LogicalShiftRight),
' and arithmetic right shift (ArithmeticShiftRight) with both fast and safe variants.
' coded by isaku@pb4.so-net.ne.jp 2026
'===========================================================
Option Explicit
'-----------------------------------------------------------
' Fast logical left shift: shifts bits of a 32-bit integer left by shiftCount positions.
' Valid for shiftCount in the range [1..30].
'-----------------------------------------------------------
Public Function FastLogicalShiftLeft&(ByVal value&, ByVal shiftCount As Byte)
Dim highBitMask&
highBitMask = 2& ^ (31 - shiftCount)
FastLogicalShiftLeft = (value And (highBitMask - 1)) * (2& ^ shiftCount)
If (value And highBitMask) = highBitMask Then FastLogicalShiftLeft = FastLogicalShiftLeft Or &H80000000
End Function
'-----------------------------------------------------------
' Fast logical right shift: shifts bits of a 32-bit integer right by shiftCount positions.
' Valid for shiftCount in the range [1..30]. Supports signed integers.
'-----------------------------------------------------------
Public Function FastLogicalShiftRight&(ByVal value&, ByVal shiftCount As Byte)
If value >= 0 Then
FastLogicalShiftRight = value \ (2& ^ shiftCount)
Else
FastLogicalShiftRight = ((value And &H7FFFFFFF) \ (2& ^ shiftCount)) Or (2& ^ (31 - shiftCount))
End If
End Function
'-----------------------------------------------------------
' Fast arithmetic right shift: shifts bits right while preserving the sign bit.
' Valid for shiftCount in the range [1..30].
'-----------------------------------------------------------
Public Function FastArithmeticShiftRight&(ByVal value&, ByVal shiftCount As Byte)
FastArithmeticShiftRight = value \ (2& ^ shiftCount)
If value < 0 And value Mod (2& ^ shiftCount) <> 0 Then FastArithmeticShiftRight = FastArithmeticShiftRight - 1
End Function
'-----------------------------------------------------------
' Logical left shift with input validation and edge case handling.
'-----------------------------------------------------------
Public Function LogicalShiftLeft&(ByVal value&, ByVal shiftCount As Byte)
Dim highBitMask&
shiftCount = shiftCount And 31 ' Limit to [0..31]
Select Case shiftCount
Case 0
LogicalShiftLeft = value
Case Is > 31
LogicalShiftLeft = 0
Case 31
LogicalShiftLeft = IIf((value And 1) = 1, &H80000000, 0)
Case Else
highBitMask = 2& ^ (31 - shiftCount)
LogicalShiftLeft = (value And (highBitMask - 1)) * (2& ^ shiftCount)
If (value And highBitMask) = highBitMask Then LogicalShiftLeft = LogicalShiftLeft Or &H80000000
End Select
End Function
'-----------------------------------------------------------
' Logical right shift with input validation and edge case handling.
'-----------------------------------------------------------
Public Function LogicalShiftRight&(ByVal value&, ByVal shiftCount As Byte)
shiftCount = shiftCount And 31 ' Limit to [0..31]
Select Case shiftCount
Case 0
LogicalShiftRight = value
Case 31
LogicalShiftRight = IIf(value < 0, 1, 0)
Case Is > 31
LogicalShiftRight = 0
Case Else
If value >= 0 Then
LogicalShiftRight = value \ (2& ^ shiftCount)
Else
LogicalShiftRight = ((value And &H7FFFFFFF) \ (2& ^ shiftCount)) Or (2& ^ (31 - shiftCount))
End If
End Select
End Function
'-----------------------------------------------------------
' Arithmetic right shift with input validation and edge case handling.
'-----------------------------------------------------------
Public Function ArithmeticShiftRight&(ByVal value&, ByVal shiftCount As Byte)
shiftCount = shiftCount And 31 ' Limit to [0..31]
Select Case shiftCount
Case 0
ArithmeticShiftRight = value
Case Is >= 31
ArithmeticShiftRight = IIf(value < 0, -1, 0)
Case Else
ArithmeticShiftRight = value \ (2& ^ shiftCount)
If value < 0 And value Mod (2& ^ shiftCount) <> 0 Then ArithmeticShiftRight = ArithmeticShiftRight - 1
End Select
End Function