‘将任意整数分解为等比数列之中的数值
Dim vRet As Variant
vRet = GeometricSeriesEx(2147483647)
For I = LBound(vRet) To UBound(vRet)
Debug.Print vRet(I)
Next I
Public Function GeometricSeriesEx(ByVal lData As Long) As Variant ‘分解整数为 1 2 4 8 16 32 64 … …，且每个数只出现一次
Dim I As Integer, J As Integer
If Not IsNumericEx(lData) Then Exit Function
Dim sBin As String
sBin = DEC_to_BIN(lData)
Dim iCount As Integer
Dim TempArray() As Long
For I = 1 To Len(sBin)
If Mid(sBin, I, 1) = “1” Then
ReDim Preserve TempArray(0 To iCount)
TempArray(iCount) = 2 ^ (Len(sBin) – I)
iCount = iCount + 1
End If
Next I
GeometricSeriesEx = TempArray
End Function
Public Function DEC_to_BIN(Dec As Long) As String ‘十进制转化为二进制
DEC_to_BIN = “”
Do While Dec > 0
DEC_to_BIN = Dec Mod 2 & DEC_to_BIN
Dec = Dec \ 2
Loop
End Function
Public Function IsNumericEx(ByVal sData As String) As Boolean ‘电子表格空格被 IsNumeric 视为数值 0,IsNumericEx 则视为字符 “”
IsNumericEx = False
sData = Trim(sData)
If sData = “” Then Exit Function
IsNumericEx = IsNumeric(sData)
End Function
Public Function IsInteger(ByVal txtString As String) As Boolean ‘是数值，且是整数
IsInteger = True
If Not IsNumeric(txtString) Then
IsInteger = False
Exit Function
End If
If Not CDbl(txtString) / 1 = CDbl(txtString) \ 1 Then
IsInteger = False
End If
End Function
Public Function IsInRange(ByVal sData As String, ByVal LowerLimit As Double, ByVal UpperLimit As Double, ByVal bAllowThreshold As Boolean) As Boolean ‘判断某数据是不是数值，且是否在界内
IsInRange = False
If Not IsNumeric(sData) Then Exit Function ‘字符等视为越界,防止以下比较时发生错误
If bAllowThreshold Then ‘压界算在界内
If CDbl(sData) > UpperLimit Then Exit Function ‘越上界
If CDbl(sData) < LowerLimit Then Exit Function ‘越下界 Else ‘压界不算在界内 If CDbl(sData) >= UpperLimit Then Exit Function ‘越上界
If CDbl(sData) <= LowerLimit Then Exit Function ‘越下界
End If
IsInRange = True
End Function