关于微机由于数据精度产生的漂移有什么好的解决方法？

[schzh]

例如：20个双精度数据累加，本来是确切的30，但由于精度，在十几位后产生一个漂移，
那结果就可能是30.000000000000000001,这本来没什么，但如果要求平均，保留一位小数，因为round,cint,clng等函数按照“四舍六入五留双”的原则计算，那结果就是1.6，而不是1.5（有尾恒留双），请教诸位有什么通用的方法？

[schzh]

继续寻求答案

[caile]

编程太难了
晕

[脆皮大雪糕]

可以先把双精度数化为整数，比如30.000000000000000000 转换为30000000000000000000 进行计算，甚至再多加几个0用于积累误差，然后做高精度整数运算。运算后将积累误差的几位去掉然后再恢复浮点。呵呵，可能这个办法比较笨，大家看看还有什么办法

下面给你一个我收集到的大数高精度精确运算模块，都是整数运算

Attribute VB_Name = "ModOperation"
'大数运算模块(仅支持正整数运算)
'作者：刺猬
'本模块您可以任意使用或传播，但是请不要删除上面的说明文字，
'如用于商业用途，请在Credit里面注明使用本模块，谢谢合作！

Function StrADC(Num1 As String, Num2 As String) As String '加法运算
Dim Result As String, ResultByte() As Long, MaxResult As Long
Dim i As Long, j As Long, TempByte As Long
Dim NumByte1() As Long, NumByte2() As Long
Dim LengthOfNum1 As Long, LengthOfNum2 As Long
DelSpace Num1
DelSpace Num2
If Trim(Num1) = "" Then Num1 = "0"
If Trim(Num2) = "" Then Num2 = "0"
LengthOfNum1 = Len(Num1): LengthOfNum2 = Len(Num2) '取得数据长度
ReDim NumByte1(1 To LengthOfNum1) As Long
ReDim NumByte2(1 To LengthOfNum2) As Long
ReDim ResultByte(1 To IIf(LengthOfNum1 > LengthOfNum2, LengthOfNum1 + 1, LengthOfNum2 + 1)) As Long
j = LengthOfNum1
For i = 1 To LengthOfNum1 '将数据逆向保存到数组中
NumByte1(i) = Mid(Num1, j, 1)
j = j - 1
Next i
j = LengthOfNum2
For i = 1 To LengthOfNum2 '同上
NumByte2(i) = Mid(Num2, j, 1)
j = j - 1
Next i
For i = 1 To UBound(ResultByte) - 1 '进行运算
If (i <= LengthOfNum2) And (i <= LengthOfNum1) Then
TempByte = NumByte1(i) + NumByte2(i) + ResultByte(i) '各个数位进行加法运算
ElseIf (i <= LengthOfNum2) Then
TempByte = NumByte2(i) + ResultByte(i) '同上
ElseIf (i <= LengthOfNum1) Then
TempByte = NumByte1(i) + ResultByte(i) '同上
End If
If TempByte < &HA Then '如果TempByte小于10
ResultByte(i) = TempByte '直接输出TempByte到保存最终结果的数组
Else '否则
ResultByte(i) = TempByte - 10 '将TempByte减去10再保存到最终结果
ResultByte(i + 1) = 1 '进位1
End If
Next i
MaxResult = UBound(ResultByte)
For i = UBound(ResultByte) To 1 Step -1 '去掉前面多余的零
If ResultByte(i) = 0 Then MaxResult = MaxResult - 1 Else Exit For
Next i
For i = 1 To MaxResult '输出结果
Result = CStr(ResultByte(i)) + Result
Next i
StrADC = Result
End Function

Function StrLt(Num1 As String, Num2 As String) As Boolean
'如果Num1小于Num2，输出结果True，否则输出结果False
Dim LengthOfNum1 As Long, LengthOfNum2 As Long
Dim i As Long
Dim NumByte1 As Long, NumByte2 As Long
DelSpace Num1
DelSpace Num2
LengthOfNum1 = Len(Num1): LengthOfNum2 = Len(Num2)
If LengthOfNum1 > LengthOfNum2 Then '进行长度比较
StrLt = False
ElseIf LengthOfNum1 < LengthOfNum2 Then '同上
StrLt = True
Else '如果长度相等
For i = 1 To LengthOfNum1 '逐位进行比较
NumByte1 = Mid(Num1, i, 1)
NumByte2 = Mid(Num2, i, 1)
If NumByte1 <> NumByte2 Then '如果不相等
If NumByte1 < NumByte2 Then StrLt = True '且Num1的那位小于Num2的那位，输出True
Exit For '不管是否为True，都退出循环
End If
Next i
End If
End Function

Function StrMt(Num1 As String, Num2 As String) As Boolean
'如果Num1大于Num2，输出结果True，否则输出结果False
Dim LengthOfNum1 As Long, LengthOfNum2 As Long
Dim i As Long
Dim NumByte1 As Long, NumByte2 As Long
DelSpace Num1
DelSpace Num2
If Trim(Num1) = "" Then Num1 = "0"
If Trim(Num2) = "" Then Num2 = "0"
LengthOfNum1 = Len(Num1): LengthOfNum2 = Len(Num2)
If LengthOfNum1 < LengthOfNum2 Then '进行长度比较
StrMt = False
ElseIf LengthOfNum1 > LengthOfNum2 Then '同上
StrMt = True
Else
For i = 1 To LengthOfNum1 '逐位进行比较
NumByte1 = Mid(Num1, i, 1)
NumByte2 = Mid(Num2, i, 1)
If NumByte1 <> NumByte2 Then '如果不相等
If NumByte1 > NumByte2 Then StrMt = True '且Num1的那位大于Num2的那位，输出Ture
Exit For '不管是否为True，都退出循环
End If
Next i
End If
End Function

Function StrSwap(Num1 As String, Num2 As String) As Boolean
'进行数据的交换
Dim ChangeNum As String
ChangeNum = Num1
Num1 = Num2
Num2 = ChangeNum
StrSwap = True
End Function

Function StrSBB(Num1 As String, Num2 As String) As String '减法运算
Dim Result As String, ResultByte() As Long, MaxResult As Long
Dim i As Long, j As Long, TempByte As Long
Dim NumByte1() As Long, NumByte2() As Long
Dim LengthOfNum1 As Long, LengthOfNum2 As Long
DelSpace Num1
DelSpace Num2
If Trim(Num1) = "" Then Num1 = "0"
If Trim(Num2) = "" Then Num2 = "0"
If StrLt(Num1, Num2) = True Then StrSwap Num1, Num2 '如果Num1小于Num2，交换位置
LengthOfNum1 = Len(Num1): LengthOfNum2 = Len(Num2) '取得数据长度
ReDim NumByte1(1 To LengthOfNum1) As Long
ReDim NumByte2(1 To LengthOfNum2) As Long
ReDim ResultByte(1 To LengthOfNum1) As Long
j = LengthOfNum1
For i = 1 To LengthOfNum1 '将数据逆向保存到数组中
NumByte1(i) = Mid(Num1, j, 1)
j = j - 1
Next i
j = LengthOfNum2
For i = 1 To LengthOfNum2 '同上
NumByte2(i) = Mid(Num2, j, 1)
j = j - 1
Next i
For i = 1 To UBound(ResultByte) '进行运算
If i <= LengthOfNum2 Then
TempByte = NumByte1(i) - NumByte2(i) '各个数位进行加法运算
If TempByte < &H0 Then '如果小于0了
TempByte = TempByte + 10 '加上10
NumByte1(i + 1) = NumByte1(i + 1) - 1 '向上借一位
End If
Else
TempByte = NumByte1(i)
End If
ResultByte(i) = TempByte '输出TempByte到保存最终结果的数组
Next i
MaxResult = UBound(ResultByte)
For i = UBound(ResultByte) To 1 Step -1 '去掉前面多余的零
If ResultByte(i) = 0 Then MaxResult = MaxResult - 1 Else Exit For
Next i
For i = 1 To MaxResult '输出结果
Result = CStr(ResultByte(i)) + Result
Next i
StrSBB = Result
End Function

Function StrMUL(Num1 As String, Num2 As String) As String '乘法运算
Dim Result As String, ResultByte() As Long, MaxResult As Long
Dim i As Long, j As Long, fi As Long, TempByte As Long, TempHighByte As Long
Dim NumByte1() As Long, NumByte2() As Long
Dim LengthOfNum1 As Long, LengthOfNum2 As Long
DelSpace Num1
DelSpace Num2
If Trim(Num1) = "" Then Num1 = "0"
If Trim(Num2) = "" Then Num2 = "0"
LengthOfNum1 = Len(Num1): LengthOfNum2 = Len(Num2) '取得数据长度
ReDim NumByte1(1 To LengthOfNum1) As Long
ReDim NumByte2(1 To LengthOfNum2) As Long
ReDim ResultByte(1 To LengthOfNum1 + LengthOfNum2) As Long
j = LengthOfNum1
For i = 1 To LengthOfNum1 '将数据逆向保存到数组中
NumByte1(i) = Mid(Num1, j, 1)
j = j - 1
Next i
j = LengthOfNum2
For i = 1 To LengthOfNum2 '同上
NumByte2(i) = Mid(Num2, j, 1)
j = j - 1
Next i
For i = 1 To LengthOfNum1 '进行运算
For j = 1 To LengthOfNum2
TempByte = NumByte1(i) * NumByte2(j) '各位进行乘法运算
fi = i + j - 1 '计算偏移位
If TempByte < &HA Then '如果小于10
ResultByte(fi) = ResultByte(fi) + TempByte '直接输出到ResultByte(fi)中
Else '否则
TempHighByte = TempByte \ 10 '计算进位的多少
ResultByte(fi) = ResultByte(fi) + TempByte - TempHighByte * 10 '计算个位
ResultByte(fi + 1) = ResultByte(fi + 1) + TempHighByte '向上进位
End If
If ResultByte(fi) > &H9 Then '如果ResultByte(fi)大于10
TempHighByte = ResultByte(fi) \ 10 '输出进位的多少
ResultByte(fi) = ResultByte(fi) - TempHighByte * 10 '计算个位
ResultByte(fi + 1) = ResultByte(fi + 1) + TempHighByte '向上进位
End If
Next j
Next i
MaxResult = UBound(ResultByte)
For i = UBound(ResultByte) To 1 Step -1 '去掉前面多余的零
If ResultByte(i) = 0 Then MaxResult = MaxResult - 1 Else Exit For
Next i
For i = 1 To MaxResult '输出结果
Result = CStr(ResultByte(i)) + Result
Next i
If Trim$(Result) <> "" Then StrMUL = Result Else StrMUL = "0"
End Function

[脆皮大雪糕]

接上面

Function StrDIV(Num1 As String, Num2 As String, ModNum As String) As String '除法运算
Dim Result As String, ResultByte() As Long, MaxResult As Long
Dim i As Long, j As Long, fi As Long, TempNum As String, TempModNum As String
Dim LengthOfNum1 As Long, LengthOfNum2 As Long
DelSpace Num1
DelSpace Num2
If Num1 = "0" Or Num2 = "0" Then
ModNum = "0"
Exit Function
End If
If StrLt(Num1, Num2) = True Then
ModNum = Num1
Exit Function
'StrSwap Num1, Num2 '如果Num1小于Num2，交换位置
End If
LengthOfNum1 = Len(Num1): LengthOfNum2 = Len(Num2) '取得数据长度
ReDim ResultByte(1 To LengthOfNum1 - LengthOfNum2 + 1) As Long
fi = LengthOfNum1 - LengthOfNum2 + 1
TempNum = Left(Num1, LengthOfNum2) '取得前LengthOfNum2位
For i = LengthOfNum2 To LengthOfNum1 '进行运算
If i > LengthOfNum2 Then TempNum = TempNum & Mid(Num1, i, 1) '增加一位
If StrLt(TempNum, Num2) = False Then '如果TempNum不小于Num2
For j = 2 To 10 '进行测试
If StrMt(StrXLng(Num2, j), TempNum) = True Then '直到Num2 * j大于TempNum为止
ResultByte(fi) = j - 1 '输出最终结果到ResultByte(fi)
TempNum = StrSBB(TempNum, StrXLng(Num2, ResultByte(fi))) '取得余数
Exit For
End If
Next j
End If
fi = fi - 1
Next i
MaxResult = UBound(ResultByte)
For i = UBound(ResultByte) To 1 Step -1 '去掉前面多余的零
If ResultByte(i) = 0 Then MaxResult = MaxResult - 1 Else Exit For
Next i
For i = 1 To MaxResult '输出结果
Result = CStr(ResultByte(i)) + Result
Next i
If Trim$(TempNum) <> "" Then ModNum = TempNum Else ModNum = "0"
If Trim$(Result) <> "" Then StrDIV = Result Else StrDIV = "0"
End Function

Public Function StrXLng(Num1 As String, Num2 As Long) As String '进行Long变量和String变量的混合乘法运算(速度有提升)
Dim Result As String, ResultByte() As Long, MaxResult As Long
Dim i As Long, TempByte As Long, TempHighByte As Long
Dim NumByte1() As Long
Dim LengthOfNum1 As Long
LengthOfNum1 = Len(Num1) '取得数据长度
ReDim NumByte1(1 To LengthOfNum1) As Long
ReDim ResultByte(1 To LengthOfNum1 + 1) As Long
j = LengthOfNum1
For i = 1 To LengthOfNum1 '将数据逆向保存到数组中
NumByte1(i) = Mid(Num1, j, 1)
j = j - 1
Next i
For i = 1 To LengthOfNum1 '进行运算
TempByte = NumByte1(i) * Num2 '各位进行乘法运算
If TempByte < &HA Then '如果小于10
ResultByte(i) = ResultByte(i) + TempByte '直接输出到ResultByte(fi)中
Else '否则
TempHighByte = TempByte \ 10 '计算进位的多少
ResultByte(i) = ResultByte(i) + TempByte - TempHighByte * 10 '计算个位
ResultByte(i + 1) = ResultByte(i + 1) + TempHighByte '向上进位
End If
If ResultByte(i) > &H9 Then '如果ResultByte(fi)大于10
TempHighByte = ResultByte(i) \ 10 '输出进位的多少
ResultByte(i) = ResultByte(i) - TempHighByte * 10 '计算个位
ResultByte(i + 1) = ResultByte(i + 1) + TempHighByte '向上进位
End If
Next i
MaxResult = UBound(ResultByte)
For i = UBound(ResultByte) To 1 Step -1 '去掉前面多余的零
If ResultByte(i) = 0 Then MaxResult = MaxResult - 1 Else Exit For
Next i
For i = 1 To MaxResult '输出结果
Result = CStr(ResultByte(i)) + Result
Next i
StrXLng = Result
End Function

Function StrHex2Dec(HexStr As String) As String
Dim Result As String, TempStr As String
Dim LengthOfHex As Long, i As Long, j As Long, HexBytes() As String
LengthOfHex = Len(HexStr)
ReDim HexBytes(1 To LengthOfHex)
ReDim DecBytes(1 To LengthOfHex + 1)
For j = LengthOfHex To 1 Step -1
i = i + 1
Select Case Mid(HexStr, j, 1)
Case "F"
HexBytes(i) = "15"
Case "E"
HexBytes(i) = "14"
Case "D"
HexBytes(i) = "13"
Case "C"
HexBytes(i) = "12"
Case "B"
HexBytes(i) = "11"
Case "A"
HexBytes(i) = "10"
Case "9"
HexBytes(i) = "9"
Case "8"
HexBytes(i) = "8"
Case "7"
HexBytes(i) = "7"
Case "6"
HexBytes(i) = "6"
Case "5"
HexBytes(i) = "5"
Case "4"
HexBytes(i) = "4"
Case "3"
HexBytes(i) = "3"
Case "2"
HexBytes(i) = "2"
Case "1"
HexBytes(i) = "1"
Case "0"
HexBytes(i) = "0"
End Select
Next j
Result = "0"
For i = 1 To LengthOfHex
TempStr = HexBytes(i)
For j = 2 To i
TempStr = StrMUL(TempStr, "16")
Next j
Result = StrADC(TempStr, Result)
Next i
If Trim$(Result) <> "" Then StrHex2Dec = Result Else StrHex2Dec = "0"
End Function

Function DelSpace(Num As String) As Boolean
Dim i As Long
For i = 1 To Len(Num)
If Left(Num, 1) = "0" Then Num = Right(Num, Len(Num) - 1) Else Exit For
Next i
DelSpace = True
End Function

Public Function ArrADC(ByRef Num1() As Long, ByRef Num2() As Long) As Long() '加法
Dim Ans() As Long
Dim LNum1 As Long
Dim LNum2 As Long
Dim TNum1() As Long
Dim TNum2() As Long
Dim Result() As Long
Dim i As Long
Dim j As Long
Dim kk As Long

Dim IsN As Boolean

LNum1 = UBound(Num1)
LNum2 = UBound(Num2)

If LNum1 > LNum2 Then
i = LNum1
ReDim TNum2(i)
TNum1() = Num1
kk = LongToLong(Num2(), TNum2(), LNum2)
Else
i = LNum2
ReDim TNum1(i)
kk = LongToLong(Num1(), TNum1(), LNum1)
TNum2() = Num2
End If

ReDim Ans(i)

For j = 0 To i

Ans(j) = TNum1(j) + TNum2(j)

If IsN = True Then Ans(j) = Ans(j) + 1

If Ans(j) >= &H1000 Then
Ans(j) = Ans(j) - &H1000
IsN = True
Else
IsN = False
End If
Next

If IsN = True Then
ReDim Result(i + 1)
Result(i + 1) = 1
kk = LongToLong(Ans(), Result(), i)
Else
ReDim Result(i)
Result() = Ans
End If
ArrADC = Result
End Function

Public Function ArrSBB(ByRef Num1() As Long, ByRef Num2() As Long) As Long() '减法
Dim Ans() As Long
Dim LNum1 As Long
Dim LNum2 As Long
Dim TNum1() As Long
Dim TNum2() As Long
Dim Result() As Long
Dim i As Long
Dim j As Long
Dim kk As Long
Dim IsN As Boolean

LNum1 = UBound(Num1)
LNum2 = UBound(Num2)

If ArrMt(Num1(), Num2()) = True Then
i = LNum1
ReDim TNum2(i)
TNum1() = Num1
kk = LongToLong(Num2(), TNum2(), LNum2)
Else
i = LNum2
ReDim TNum2(i)
TNum1() = Num2
kk = LongToLong(Num1(), TNum2(), LNum1)
End If

ReDim Ans(i)
For j = 0 To i
Ans(j) = TNum1(j) - TNum2(j)
If IsN = True Then Ans(j) = Ans(j) - 1
If Ans(j) < 0 Then
Ans(j) = Ans(j) + &H1000
IsN = True
Else
IsN = False
End If
Next

i = UBound(Ans)
If i <> 0 Then
For j = i To 1 Step -1
If Ans(j) <> 0 Then Exit For
Next
Else
j = 0
End If

ReDim Result(j)
kk = LongToLong(Ans(), Result(), j)
ArrSBB = Result
End Function

[脆皮大雪糕]

再接

Public Function ArrMUL(ByRef Num1() As Long, ByRef Num2() As Long) As Long() '乘法
Dim LNum1 As Long
Dim LNum2 As Long
Dim Tmp As Long
Dim Ans() As Long
Dim Result() As Long
Dim i As Long
Dim j As Long

LNum1 = UBound(Num1)
LNum2 = UBound(Num2)
Tmp = LNum1 + LNum2 + 1
ReDim Ans(Tmp)
For i = 0 To LNum1
For j = 0 To LNum2
Ans(i + j) = Ans(i + j) + Num1(i) * Num2(j)
If Ans(i + j) >= &H1000 Then
Ans(i + j + 1) = Ans(i + j + 1) + Int(Ans(i + j) / &H1000)
Ans(i + j) = Ans(i + j) Mod &H1000
End If
Next
Next

i = UBound(Ans)
If i <> 0 Then
For j = i To 1 Step -1
If Ans(j) <> 0 Then Exit For
Next
Else
j = 0
End If

ReDim Result(j)
i = LongToLong(Ans(), Result(), j)
ArrMUL = Result
End Function

Public Function ArrDIV(ByRef Num1() As Long, ByRef Num2() As Long, ModResult() As Long) As Long() '除法
Dim LNum1 As Long
Dim LNum2 As Long
Dim Ans() As Long
Dim TNum1() As Long
Dim Result() As Long
Dim i As Long
Dim kk As Long
Dim Tmp() As Long
Dim Tmp2() As Long

LNum2 = UBound(Num2)
ReDim Ans(0)
Ans(0) = 0
Do While kk = 0

TNum1() = ArrSBB(Num1(), ArrMUL(Ans(), Num2()))

If ArrMt(Num2(), TNum1()) Then Exit Do

LNum1 = UBound(TNum1)

ReDim Tmp(0)
Tmp(0) = Int(TNum1(LNum1) / (Num2(LNum2) + 1))

If Tmp(0) = 0 And LNum1 <> 0 Then
Tmp(0) = Int((TNum1(LNum1) * &H1000 + TNum1(LNum1 - 1)) / (Num2(LNum2) + 1))
LNum1 = LNum1 - 1
ElseIf Tmp(0) = 0 And LNum1 = 0 Then
Tmp(0) = Int(TNum1(LNum1) * &H1000 / (Num2(LNum2) + 1))
LNum1 = LNum1 - 1
End If

If LNum1 - LNum2 <> -1 Then
Tmp() = ArrShl(Tmp(), LNum1 - LNum2)
Else
Tmp(0) = 1
End If
Ans() = ArrADC(Ans(), Tmp())

Loop

LNum1 = UBound(Ans)

If LNum1 <> 0 Then
For i = LNum1 To 1 Step -1
If Ans(i) <> 0 Then Exit For
Next
Else
i = 0
End If

ReDim Result(i)
kk = LongToLong(Ans(), Result(), i)
ModResult() = TNum1
ArrDIV = Result
End Function

Public Function ArrShl(Num() As Long, n As Long) As Long() '左位移
Dim i As Long, Result() As Long
ReDim Result(UBound(Num) + n)
For i = 0 To UBound(Num)
Result(i + n) = Num(i)
Next i
ArrShl = Result
End Function

Public Function ArrShr(Num() As Long, n As Long) As Long() '右位移
Dim i As Long, Result() As Long
ReDim Result(UBound(Num) - n)
For i = 0 To UBound(Num)
Result(i - n) = Num(i)
Next i
ArrShr = Result
End Function

Public Function ArrMutMod(ByRef Num1() As Long, ByRef Num2() As Long, ByRef ModNum() As Long) As Long() '模乘
Dim Num() As Long
Dim Result() As Long
ArrDIV ArrMUL(Num1(), Num2()), ModNum(), Result()
ArrMutMod = Result
End Function

Public Function ArrMiMod(ByRef Num1() As Long, ByRef NumT() As Long, ByRef ModNum() As Long) As Long() '模幂
Dim Numb0() As Long
Dim Numb1() As Long
Dim Numb2() As Long
Dim e() As Long
Dim c() As Long
Dim d() As Long
Dim TmpNum() As Long


ReDim Numb0(0)
ReDim Numb1(0)
ReDim Numb2(0)
Numb0(0) = 0
Numb1(0) = 1
Numb2(0) = 2

e = NumT
c = Num1
ReDim d(0)
d(0) = 1
Do While ArrMt(e, Numb0)

If e(0) Mod 2 = 0 Then
c() = ArrMutMod(c(), c(), ModNum())
e = ArrDIV(e, Numb2, TmpNum())
Else
d() = ArrMutMod(d(), c(), ModNum())
e = ArrSBB(e, Numb1)
End If
Loop

ArrMiMod = d

End Function

Public Function LongToLong(ByRef Num1() As Long, Num2() As Long, ByVal L1 As Long) As Long
Dim i As Long
For i = 0 To L1
Num2(i) = Num1(i)
Next
End Function

Private Function ArrMt(ByRef Num1() As Long, Num2() As Long) As Boolean
Dim LNum1 As Long
Dim LNum2 As Long
Dim i As Long

LNum1 = UBound(Num1)
LNum2 = UBound(Num2)
If LNum1 > LNum2 Then
ArrMt = True
ElseIf LNum2 > LNum1 Then
ArrMt = False
Else
For i = LNum1 To 0 Step -1
If Num1(i) > Num2(i) Then
ArrMt = True
Exit For
ElseIf Num1(i) < Num2(i) Then
ArrMt = False
Exit For
End If
Next
End If
End Function

Private Function ArrIs0(ByRef Num1() As Long) As Boolean
If UBound(Num1) = 0 And Num1(0) = 0 Then
ArrIs0 = True
Else
ArrIs0 = False
End If
End Function

Public Function ArrDelSpace(Num() As Long) As Boolean
Dim i As Long, MaxArr As Long
For i = UBound(Num) To 0 Step -1
If Num(i) > &H0 Then
MaxArr = i
Exit For
End If
Next i
ReDim Preserve Num(MaxArr)
End Function

Public Function HexToArr(ByVal Str As String) As Long()
Dim LNum As Long
Dim i As Long
Dim Str2 As String
Dim ReStr() As Long

LNum = Len(Str) Mod 3
If LNum = 0 Then
Str2 = Str
Else
Str2 = String(3 - LNum, "0") & Str
End If
LNum = Len(Str2) / 3
ReDim ReStr(LNum - 1)
For i = 0 To LNum - 1
ReStr(i) = Val("&H" & Mid(Str2, LNum * 3 - i * 3 - 2, 3) & "&")
Next
HexToArr = ReStr()
End Function

Public Function ArrToHex(ByRef Num() As Long) As String
Dim LNum As Long
Dim i As Long
Dim s As String

Dim Ans As String

LNum = UBound(Num) - 1
For i = 0 To LNum
s = Hex(Num(i))
s = String(3 - Len(s), "0") & s
Ans = s & Ans
Next
Ans = Hex(Num(LNum + 1)) & Ans
ArrToHex = Ans
End Function