求比较一致性算法

Question

有两个数组，a（6），b（6），要比较这两个数组中的数是不是完相同，也许有的数字不在同一位置上，该怎么做啊，我写了一个小算法，不知道还能不能优化
dim num(6)
for i=0 to 5
for j=0 to 5
if a(i)=b(j) then 
num(i)=num(i)+1
exit for
end if
next j
next i
通过num(i)的情况判断是否相等，诸位还有没有什么更好的办法，谢谢了

Answer 1

各自排序了，也不能保证a(0)=b(0),如果a(0)=b(1)呢，我还要确定一下如果不一致的时候有多少一致的，并且各自排序是不是会比这样运算量更大呢

Answer 2

楼主的方法似乎不大正确
这样做：
for i=0 to 5
  for j=0 to 5
    if b(j)=a(i) and not used(j) then
      k=k+1
      used(j)=true
      exit for
    end if
  next j
next i
if k=5 then msgbox "match all"
楼上的方法时间复杂度虽然也是O(n^2)，但是实际上是n^2*2+n
楼主的方法由漏洞，需要判断是否用过，否则应该会出现5,5,5,5,5,5和5,1,2,2,3,4匹配的事情吧

Answer 3

Option ExplicitPrivate Sub Command1_Click()
Dim a(10) As String, b(10) As String, c(10) As String, i As Long
For i = 0 To 10
a(i) = i
b(i) = 10 - i
c(i) = 9 - i
Next
MsgBox issame(a(), b())
MsgBox issame(a(), c())
End Sub
Function issame(ByRef a() As String, ByRef b() As String) As Boolean
Dim min As Long, max As Long, i As Long
min = LBound(a)
max = UBound(a)
If Not (UBound(b) = max And LBound(b) = min) Then
issame = False
Exit Function
Else
For i = min To max
If UBound(Filter(b(), a(i))) < 0 Or UBound(Filter(a(), b(i))) < 0 Then
issame = False
Exit Function
Else
issame = True
End If
Next
End If
End Function

Answer 4

for i=0 to 4
  for j=i+1 to 5
    if a(i)>a(j) then
      tmp=a(i)
      a(i)=a(j)
      a(j)=tmp
    end if
  next j
next ifor i=0 to 4
  for j=i+1 to 5
    if b(i)>b(j) then
      tmp=b(i)
      b(i)=b(j)
      b(j)=tmp
    end if
  next j
next iflag=0
for i=0 to 5
  if a(i)<>b(i) then
    flag=1
    exit for
  end if'flag是0则完全相同
       1则有所不同

Answer 5

to northwolves(狼行天下) 你的方法可以判断是否完全相同，但是只能对字符串有效，并且在10与0，1这样之间判断时好像能有不可预期的错误，我没有自己验看，并且能不能确定一一样的个数呢？
to  thirdapple(.:RNPA:.陨落雕-鍾意吊帶MM) 我能保证各个数组元素的唯一性，所以不需要再去判断了，并且我希望能简化运算，现在我的运算量太大了。
to wzhjs(Flower) 你的办法只能验证所有元素的一致行，但是如果我希望能知道有多少个数组元素相同就无能为力了，有没有这样的好办法啊

Answer 6

如果知道数组的上限，可以借鉴桶排序的方法：
Dim Num(9999) As Boolean
Dim IsMatch As BooleanFor i=0 To 5
  Num(a(i)) = True
Next iIsMatch = True
For i=0 To 5
  If Not Num(b(i)) Then
    IsMatch = False
  End If
Next iIf IsMatch Then msgbox "Match All"这样的算法只需要O(2n)时间复杂度，不过需要很大的内存空间

Answer 7

其实可以利用COLLECTION 实现：Option ExplicitPrivate Sub Command1_Click()
Dim a(10) As Long, b(10) As Long, c(10) As Long, i As Long
For i = 0 To 10
a(i) = i
b(i) = 10 - i
c(i) = 8 - i
Next
diag a, b
diag a, c
End Sub
Sub diag(ByRef a, ByRef b, Optional ByRef num As Long)
On Error Resume Next
Dim min As Long, max As Long, i As Long, j As Long, x As New Collection
min = LBound(a)
max = UBound(a)
If Not (UBound(b) = max And LBound(b) = min) Then
MsgBox "两数组个数不同"
Exit Sub
Else
For i = min To max
x.Add a(i), "key" & a(i)
x.Add b(i), "key" & b(i)
Next
If x.Count = max - min + 1 Then
MsgBox "两数组完全相同"
Else
num = 2 * (max - min + 1) - x.Count
MsgBox "两数组有 " & num & "个相同， " & (max - min + 1) - num & "个不同"
End If
End If
End Sub

Answer 8

不知到你数组里元素的值是不是唯一的，可以试试这样：Private Sub Command1_Click()
Randomize
Dim a(1 To 10) As Integer
Dim b(1 To 10) As Integer
Dim sa As String
Dim sb As String
Dim temp As Integer
sa = ","
sb = ","
For i = 1 To 10
a(i) = Int(10 * Rnd + 1)
b(i) = Int(10 * Rnd + 1)
sa = sa + Trim(Str(a(i))) + ","
sb = sb + Trim(Str(b(i))) + ","
Next
Print sa
Print sbFor i = 1 To 10
If InStr(1, sb, "," + Trim(Str(a(i))) + ",") = 0 Then
Print "数组b中不含有a（" & Trim(Str(i)) & "）的值" & Trim(Str(a(i)))
End If
Next
End Sub上面的程序只考虑数组A的值有没有出现在数组B中，而没有对重复的值进行判断，如果有需要可以再改进。

Answer 9

to northwolves(狼行天下)
能不能把collection的详细使用方法说明一下，刚才去看msdn没有看得太明白，今天真的看到高手了，能在qq上向您请教么？我的qq8727492，顺便问一句，在vbscirpt上有这个么？

Answer 10

vbscirpt:  dictionary 功能较 COLLECTION 明显加强。数据较少时 COLLECTION 由于关键字的唯一性，还是可以起到很多出乎意料的作用。

Answer 11

上面我写的程序的改良版：Private Sub Command1_Click()
Randomize
Dim a(1 To 6) As Integer
Dim b(1 To 6) As Integer
Dim sa As String
Dim sb As String
Dim msg As String
Dim tempa As String
Dim tempb As String
Dim counta As Integer
Dim countb As Integer
sa = ","
sb = ","
For i = 1 To 6
a(i) = Int(10 * Rnd + 1)
b(i) = Int(10 * Rnd + 1)
sa = sa + Trim(Str(a(i))) + ","
sb = sb + Trim(Str(b(i))) + ","
Next
tempa = sa
tempb = sb
Print sa
Print sb
For i = 1 To 6
If InStr(1, sb, "," + Trim(Str(a(i))) + ",") = 0 Then
msg = msg + "数组b中不含有a（" & Trim(Str(i)) & "）的值" & Trim(Str(a(i))) + Chr(13)
Else
Do Until InStr(1, tempa, "," + Trim(Str(a(i))) + ",") = 0
DoEvents
counta = counta + 1
tempa = Right(tempa, Len(tempa) - InStr(1, tempa, "," + Trim(Str(a(i))) + ",") - Len("," + Trim(Str(a(i))) + ",") + 2)
Loop
Do Until InStr(1, tempb, "," + Trim(Str(a(i))) + ",") = 0
DoEvents
countb = countb + 1
tempb = Right(tempb, Len(tempb) - InStr(1, tempb, "," + Trim(Str(a(i))) + ",") - Len("," + Trim(Str(a(i))) + ",") + 2)
Loop
If counta <> countb Then
If InStr(1, msg, "数组a中出现值" + Trim(a(i)) + "有" + Trim(counta) + "次，" + "数组b中出现值" + Trim(a(i)) + "有" + Trim(countb) + "次." + Chr(13)) = 0 Then
msg = msg + "数组a中出现值" + Trim(a(i)) + "有" + Trim(counta) + "次，" + "数组b中出现值" + Trim(a(i)) + "有" + Trim(countb) + "次." + Chr(13)
End If
End If
tempa = sa
tempb = sb
counta = 0
countb = 0
End If
If InStr(1, sa, "," + Trim(Str(b(i))) + ",") = 0 Then
msg = msg + "数组a中不含有b（" & Trim(Str(i)) & "）的值" & Trim(Str(b(i))) + Chr(13)
End If
Next
If Len(msg) = 0 Then msg = "数组a与数组b里的值一样。"
Print msg
End Sub如果结果出现"数组a与数组b里的值一样。"，就是两个数组的值一样了。。
另外，在测试程序的时候，发现用
cou=（len(str1)-len(replace(str1,str2,""))）/(len(str2))
这种方法来求字符串str2在字符串str1中出现的次数是有缺陷的，也算是一个意外的小收获

Answer 12

用我的“推土机”算法（也叫做“馄饨算法”）：
用a(i)-b(i)得到c()，然后计算c()所有元素的和，如果结果是0，则完全匹配。

Answer 13

tLCount=LBound(A())
tUCount=UBound(B())For tIndex=tLCount To tUCount
  tAdd=tAdd+(A(tIndex)-B(tIndex))
NexttOutBool=Not CBool(tAdd)tOutBool为真则是完全匹配。
tOutBool为假则是不匹配。

Answer 14

测试代码：如果Text1.text和Text2.Text匹配，则输出True
Private Sub Command1_Click()
  Dim tArrayA() As Byte
  Dim tArrayB() As Byte
  tArrayA() = Text1.Text
  tArrayB() = Text2.Text
  Text3.Text = Bytes_MatchingCheck(tArrayA(), tArrayB())
End SubFunction Bytes_MatchingCheck(ByRef pArrayA() As Byte, ByRef pArrayB() As Byte) As Boolean
  Dim tOutBool As Boolean
  
  Dim tArrayLength As Long
  tArrayLength = UBound(pArrayA())
  
  Dim tIndex As Long
  Dim tSumValue As Long
  
  For tIndex = 0 To tArrayLength
    tSumValue = tSumValue + (CLng(pArrayA(tIndex)) - CLng(pArrayB(tIndex)))
  Next
  
  tOutBool = Not CBool(tSumValue)
  
  Bytes_MatchingCheck = tOutBool
End Function

Answer 15

//如果知道数组的上限，可以借鉴桶排序的方法：
Dim Num(9999) As Boolean
Dim IsMatch As BooleanFor i=0 To 5
  Num(a(i)) = True
Next iIsMatch = True
For i=0 To 5
  If Not Num(b(i)) Then
    IsMatch = False
  End If
Next iIf IsMatch Then msgbox "Match All"//这样的算法只需要O(2n)时间复杂度，不过需要很大的内存空间单就算法而言，用哈希表应该是时间复杂度最低的O(2n)。用集合的方法取决于集合的效率。

Answer 16

如果数组的值在Byte和Integer范围内（也就是说不大），而数组的元素特别多。同时你想知道有多少元素被匹配，有多少不被匹配。那么我的“直方图”法可以满足你。（另外还有一个两级检测法）
复杂度比较低。Private Sub Command1_Click()
  Dim tArrayA() As Byte
  Dim tArrayB() As Byte
  Dim tMapA() As Long
  Dim tMapB() As Long
  
  tArrayA() = Text1.Text
  tArrayB() = Text2.Text  'Text3.Text = Bytes_MatchingCheck(tArrayA(), tArrayB())
  Text3.Text = Bytes_MatchingCheck2(tArrayA(), tArrayB()) '两级测试法
  Bytes_MatchingCheck3_MapGet tArrayA(), tArrayB(), tMapA(), tMapB() '直方图法
  Text4.Text = MatchingNumberGetByMap(tMapA(), tMapB()) '直方图法得到的不匹配数量。
  
End SubFunction MatchingNumberGetByMap(ByRef pMapA() As Long, ByRef pMapB() As Long) As Long
  '通过直方图计算不匹配数量。
  Dim tOutNumber As Long
  Dim tIndex As Long
  For tIndex = LBound(pMapA()) To UBound(pMapA())
    tOutNumber = tOutNumber + Abs(pMapA(tIndex) - pMapB(tIndex))
  Next
  MatchingNumberGetByMap = tOutNumber
End FunctionSub Bytes_MatchingCheck3_MapGet(ByRef pArrayA() As Byte, ByRef pArrayB() As Byte, ByRef pOutMapA() As Long, ByRef pOutMapB() As Long)
  '获得数组直方图。
  '对于文本来说，本方法最为适用。
  Dim tOutMapA() As Long
  Dim tOutMapB() As Long
  
  Dim tArrayA_Max As Byte
  Dim tArrayB_Max As Byte
  Dim tArrayA_Min As Byte
  Dim tArrayB_Min As Byte
  
  Bytes_ValueBoundGet pArrayA(), tArrayA_Max, tArrayA_Min '求数组A()元素值的上限和下限
  Bytes_ValueBoundGet pArrayA(), tArrayB_Max, tArrayB_Min '求数组B()元素值的上限和下限
  Bytes_SwapByMaxLeft tArrayA_Max, tArrayB_Max
  Bytes_SwapByMaxLeft tArrayB_Min, tArrayA_Min
  tArray_Max = tArrayA_Max
  tArray_Min = tArrayA_Min
  
  ReDim tOutMapA(tArray_Min To tArray_Max) '定义数组A直方图
  ReDim tOutMapB(tArray_Min To tArray_Max) '定义数组B直方图
  
  Dim tArrayLength As Long
  
  tArrayLength = UBound(pArrayA())
  
  For tIndex = 0 To tArrayLength '产生两数组直方图
    tOutMapA(pArrayA(tIndex)) = tOutMapA(pArrayA(tIndex)) + 1
    tOutMapB(pArrayB(tIndex)) = tOutMapB(pArrayB(tIndex)) + 1
  Next
  
  pOutMapA() = tOutMapA()
  pOutMapB() = tOutMapB()
End SubFunction Bytes_MatchingCheck2(ByRef pArrayA() As Byte, ByRef pArrayB() As Byte) As Boolean
  Dim tOutBool As Boolean
  Dim tArrayLength As Long
  
  '初级测试
  
  tOutBool = Bytes_MatchingCheck(pArrayA(), pArrayB())
  tArrayLength = tOutBool And (UBound(pArrayA()) - 1)
  
  Dim tIndexLevel1 As Long
  Dim tIndexLevel2 As Long  '次级测试  For tIndexLevel1 = 0 To tArrayLength
    For tIndexLevel2 = tIndexLevel1 To tArrayLength
      '同步排序
      Bytes_SwapByMaxLeft pArrayA(tIndexLevel1), pArrayA(tIndexLevel2)
      Bytes_SwapByMaxLeft pArrayB(tIndexLevel1), pArrayB(tIndexLevel2)
    Next
    '同步性检测
    tOutBool = tOutBool And (pArrayA(tIndexLevel1) = pArrayB(tIndexLevel1))
    If Not tOutBool Then
      '不同步立即退出
      Exit For
    End If
  Next
  
  Bytes_MatchingCheck2 = tOutBool
End FunctionFunction Bytes_MatchingCheck(ByRef pArrayA() As Byte, ByRef pArrayB() As Byte) As Boolean
  Dim tOutBool As Boolean
  
  Dim tArrayLength As Long
  tArrayLength = UBound(pArrayA())
  
  Dim tIndex As Long
  Dim tSumValue As Long
  
  For tIndex = 0 To tArrayLength
    tSumValue = tSumValue + (CLng(pArrayA(tIndex)) - CLng(pArrayB(tIndex)))
  Next
  
  tOutBool = Not CBool(tSumValue)
  
  Bytes_MatchingCheck = tOutBool
End FunctionSub Bytes_ValueBoundGet(ByRef pBytes() As Byte, ByRef pMax As Byte, ByRef pMin As Byte)
  Dim tBytes_Length As Long
  tBytes_Length = UBound(pBytes())
  
  Dim tIndex As Long
  
  pMax = pBytes(tIndex)
  pMin = pBytes(tIndex)
  
  For tIndex = 0 To tBytes_Length
    If pMax < pBytes(tIndex) Then pMax = pBytes(tIndex)
    If pMin > pBytes(tIndex) Then pMin = pBytes(tIndex)
  Next
End SubSub Bytes_SwapByMaxLeft(ByRef pA As Byte, ByRef pB As Byte)
  If pA < pB Then
    Bytes_Swap pA, pB
  End If
End SubSub Bytes_Swap(ByRef pA As Byte, ByRef pB As Byte)
  Dim tT As Byte
  tT = pA: pA = pB: pB = tT
End Sub

Answer 17

两级检测法是这样的：先用根据元素的和判断是否匹配，进行初级检测。如果元素的算术和不一样，根本就不匹配。如果一样的话，有很大概率是匹配的。只需要对数组历遍一次。
然后对初级检测后，对两个数组同步冒泡排序。因为只要两个数组匹配，那么冒泡排序时每个排序后的元素应该是一一对应的。如果有一个不同步，就说明两个数组至少有一个不匹配。上面的办法只能判断两个数组是不是匹配，但不能得知究竟有多少匹配。接下来这个办法可以满足楼主关于匹配程度的需要。此法是借鉴于图象上的直方图。什么是直方图呢：看下列这组数字1235357567561667如果统计每个数字出现的次数，则得到一个表：1 2
2 1
3 2
4 0
5 4
6 4
7 3这就是所谓“直方图”。匹配的数组，两者直方图是完全相同的。而部分匹配的数组，体现在直方图里，匹配部分也是重合的。以两者直方图做减法取绝对值，就得到不匹配元素的数量。（同时，利用直方图还有一定排序的能力）再看下面这个组数，只有一个元素与上面的不同。直方图如下。12353575675626671 1
2 2
3 2
4 0
5 4
6 4
7 3两者直方图做减法取绝对值，就得到：1
1
0
0
0
0
0给所有直方图的元素相加得到2。
（有一个不匹配得到2，两个返回4、三个返回6。请注意：前提是两个数组长度一致。）直方图的缺点是这样的：1、对取值范围有限制。如果你是对Long数组做这种操作，那么有点不大现实了。
2、如果取值范围超过数组元素数量，那么这个方法有点得不偿失。鉴于以上原因，此法对Integer和Byte类型是适用的。而复杂度与数组元素的实际取值范围有很大关系，通过检测数组元素实际范围可以尽量缩小直方图数组的长度，但这个做法却要多历遍一次数组。
不过，你还有一个选择：将Long这种类型的数组转换成Byte类型做直方图，效果是一样的（只是结果需要一些调整）。

Answer 18

thirdapple(.:RNPA:.陨落雕-鍾意吊帶MM)：好象和你的方法是两回事。你说的是哪个？再贴一下。

Answer 19

Dim Num(9999) As Boolean
Dim IsMatch As BooleanFor i=0 To 5
  Num(a(i)) = True
Next iIsMatch = True
For i=0 To 5
  If Not Num(b(i)) Then
    IsMatch = False
  End If
Next iIf IsMatch Then msgbox "Match All"一样的啊，建立一个哈希表，然后……

Answer 20

有点相似，但其实有差别的。如果是对Inetger做我那种运算要：Dim NumA(0 To 32767) As Long
Dim NumB(0 To 32767) As Long
Dim Sum As Long
Dim IsMatch As LongFor i=0 To 5
  NumA(a(i)) = NumA(a(i)) + 1
  NumB(a(i)) = NumB(a(i)) + 1
Next iFor i=0 To 32767
  Sum = Sum + (NumA(i) - NumB(i))
Next i最后得到是有多少元素不匹配，而不是匹配还是不匹配。

Answer 21

不过相同点都是“摆地摊”，如果仅仅是判断匹配不匹配，你的办法最快。另外：0 To 9999有点不安全，而我的0 To 32767又太夸张了。具体Num数组的上限和下限应该是通过A()和B()当中最小的值和最大的值求出来的，即使这样也比其他办法快。不过，真遇到一个long类型的大数，咱俩的算法就哭都来不及了。

Answer 22

我想，最后还是写一个彻底一点的函数吧：1、先计算元素取值范围。
2、决定算法：如果元素的相对取值范围（Abs(Max-Min)）不大于元素数量的平方，则使用常规的哈希表。如果大于元素数量的平方……嘿嘿！代码稍后就来，对Long类型的。

Answer 23

测试代码：Private Sub Command1_Click()
  Dim tActiveTable As New clsActiveTable_Long
  For tIndex = 10000 To 20000
    tActiveTable.Index = tIndex
    tActiveTable.Value = tIndex
    DoEvents
    Text1.Text = tActiveTable.Size
  Next
End SubPrivate Sub Command2_Click()
  Dim tA() As Long
  Dim tB() As Long
  ReDim tA(3)
  ReDim tB(3)
  
  tA(0) = 1: tA(1) = 2: tA(3) = 3: tA(3) = 4
  tB(0) = 4: tB(1) = 2: tB(3) = 3: tB(3) = 2
  
  Text1.Text = Longs_MatchCheck(tA(), tB())
End SubPrivate Sub Form_Load()End Sub
modLongs_MatchCheck代码'Static Table
'Dynamic TableEnum Longs_MatchCheck_Mode
  cmNoDetect = 0
  cmDynamicTable = 1
  cmStaticTable = 2
  cmAutoDetect = 3
End EnumFunction Longs_MatchCheck(ByRef pLongsA() As Long, ByRef pLongsB() As Long, Optional ByVal pMode As Longs_MatchCheck_Mode = 3, Optional ByVal pValueMax As Long = 9999, Optional ByVal pValueMin As Long = 0)
  
  Dim tOutBool As Boolean
  
  Dim tLongs_Min As Long
  Dim tLongs_Max As Long
  
  Select Case pMode
    Case 0, 1, 2
      tLongs_Max = pValueMax
      tLongs_Min = pValueMin
    Case 3
      tLongs_Min = Longs_FindMin(pLongsA()): tLongs_Min = Longs_FindMin(pLongsB(), tLongs_Min)
      tLongs_Max = Longs_FindMax(pLongsA()): tLongs_Max = Longs_FindMax(pLongsB(), tLongs_Max)
  End Select
  
  Dim tMode As Boolean
  Dim tValueLength As Long
  Dim tLongsLength As Long
  
  tValueLength = tLongs_Max - tLongs_Min
  tLongsLength = UBound(pLongsA())
  
  tMode = (tValueLength > tLongsLength) Or pMode = cmDynamicTable
  
  If tMode Then
      tOutBool = Longs_MatchCheck_DynamicTable(pLongsA(), pLongsB())
    Else
      tOutBool = Longs_MatchCheck_StaticTable(pLongsA(), pLongsB(), tLongs_Max, tLongs_Min)
  End If
  
  Longs_MatchCheck = tOutBool
End FunctionFunction Longs_MatchCheck_DynamicTable(ByRef pLongsA() As Long, ByRef pLongsB() As Long) As Boolean
  Dim tOutBool As Boolean
    
  Dim tIndex As Long
  Dim tIndex_Start As Long
  Dim tIndex_End As Long
  
  tIndex_Start = LBound(pLongsA())
  tIndex_End = UBound(pLongsA())
  
  Dim tActiveTable As New clsActiveTable_Long
  
  For tIndex = tIndex_Start To tIndex_End
    tActiveTable.Index = pLongsA(tIndex)
    tActiveTable.Value = -1
  Next
  
  tIndex_Start = LBound(pLongsB())
  tIndex_End = UBound(pLongsB())
  
  tOutBool = True
  
  For tIndex = tIndex_Start To tIndex_End
    tActiveTable.Index = pLongsB(tIndex)
    tOutBool = tOutBool And CBool(tActiveTable.Value)
    If Not tOutBool Then Exit For
  Next
  
  Longs_MatchCheck_DynamicTable = tOutBool
End FunctionFunction Longs_MatchCheck_StaticTable(ByRef pLongsA() As Long, ByRef pLongsB() As Long, Optional ByVal pValueMax As Long = 9999, Optional ByVal pValueMin As Long = 0) As Boolean
  Dim tOutBool As Boolean
  
  Dim tTable() As Boolean
  ReDim tTable(pValueMin To pValueMax)
  
  Dim tIndex As Long
  Dim tIndex_Start As Long
  Dim tIndex_End As Long
  
  tIndex_Start = UBound(pLongsA())
  tIndex_End = UBound(pLongsA())
  
  For tIndex = tIndex_Start To tIndex_End
    tTable(pLongsA(tIndex)) = True
  Next
  
  tIndex_Start = UBound(pLongsB())
  tIndex_End = UBound(pLongsB())
  
  tOutBool = True
  
  For tIndex = tIndex_Start To tIndex_End
    tOutBool = tOutBool And tTable(pLongsB(tIndex))
    If Not tOutBool Then Exit For
  Next
  
  Longs_MatchCheck_StaticTable = tOutBool
End FunctionFunction Longs_FindMin(ByRef pLongs() As Long, Optional ByVal pStartValue As Long = &H7FFFFFFF) As Long
  Dim tOutMin As Long
  
  tOutMin = pStartValue
  
  Dim tLongs_Length As Long
  
  tLongs_Length = UBound(pLongs())
  
  Dim tIndex As Long
  Dim tFindMin As Boolean
  
  For tIndex = 0 To tLongs_Length
    
    tFindMin = tOutMin > pLongs(tIndex)
    If tFindMin Then tOutMin = pLongs(tIndex)
    
  Next
  
  Longs_FindMin = tOutMin
End FunctionFunction Longs_FindMax(ByRef pLongs() As Long, Optional ByVal pStartValue As Long = 0) As Long
  Dim tOutMax As Long
  
  tOutMax = pStartValue
  
  Dim tLongs_Length As Long
  
  tLongs_Length = UBound(pLongs())
  
  Dim tIndex As Long
  Dim tFindMax As Boolean
  
  For tIndex = 0 To tLongs_Length
    
    tFindMax = tOutMax < pLongs(tIndex)
    If tFindMax Then tOutMax = pLongs(tIndex)
    
  Next
  
  Longs_FindMax = tOutMax
End FunctionmodActiveTable_Long代码：虚拟数组模块Type tpActiveTable_Cell
  tcIndex As Long
  tcValue As Long
End TypeFunction ActiveTable_ValueGet(ByVal pIndex As Long, ByRef pTable() As tpActiveTable_Cell) As Long
  Dim tOutValue As Long
  
  Dim tTableID As Long
  tTableID = ActiveTable_IDGet(pIndex, pTable())
  
  tOutValue = pTable(tTableID).tcValue
  
  ActiveTable_ValueGet = tOutValue
End FunctionSub ActiveTable_ValuePut(ByVal pIndex As Long, ByVal pValue As Long, ByRef pTable() As tpActiveTable_Cell)
  
  Dim tTableID As Long
  tTableID = ActiveTable_IDGet(pIndex, pTable())
  
  pTable(tTableID).tcValue = pValue
  
End SubFunction ActiveTable_IDGet(ByVal pIndex As Long, ByRef pTable() As tpActiveTable_Cell) As Long
  Dim tOutID As Long
  
  Dim tTable_Length As Long
  
  Err.Clear
  On Error Resume Next
  
  tTable_Length = UBound(pTable())
  
  If Not CBool(Err.Number) Then
    
      Dim tIndex As Long
      Dim tIDFind As Boolean
    
      For tIndex = 0 To tTable_Length
        
        tIDFind = tIDFind Or (pIndex = pTable(tIndex).tcIndex)
        If tIDFind Then tOutID = tIndex: Exit For
        
      Next
    
      If Not tIDFind Then
      
        Dim tTable_LengthNew As Long
        tTable_LengthNew = tTable_Length + 1
      
        ReDim Preserve pTable(tTable_LengthNew)
        pTable(tTable_LengthNew).tcIndex = pIndex
        
        tOutID = tTable_LengthNew
      
      End If
    
    Else
    
      ReDim pTable(0)
      pTable(0).tcIndex = pIndex
    
  End If
  
  ActiveTable_IDGet = tOutID
End FunctionclsActiveTable_Long代码：虚拟数组类模块Private priActiveTable() As tpActiveTable_Cell
Private priTableID As Long
Private priIndex As LongPublic Property Get Index() As Long
  Index = priIndex
End PropertyPublic Property Let Index(ByVal pNewValue As Long)
  priIndex = pNewValue
  priTableID = ActiveTable_IDGet(priIndex, priActiveTable())
End PropertyPublic Property Get Value() As Long
  Value = priActiveTable(priTableID).tcValue
End PropertyPublic Property Let Value(ByVal pNewValue As Long)
  priActiveTable(priTableID).tcValue = pNewValue
End PropertyPublic Property Get Size() As Long
  Size = UBound(priActiveTable())
End PropertyPublic Sub Clear()
  ReDim priActiveTable(0)
End SubPrivate Sub Class_Initialize()
  Me.Clear
End Sub