假设有 数组a 和 数组b
a（0）= 1 b（0）= 10
a（1）= 2 b（1）= 9
a（2）= 3 b（2）= 8
a（3）= 4 b（3）= 7
a（4）= 5 b（4）= 6
a（5）= 6 b（5）= 5
a（6）= 7 b（6）= 4
a（7）= 8 b（7）= 3
顺序是乱的。随机生成的。
如可判读 a b两数组的值 有一半以上是相同的。
数组大小 都在3000以上的 逐个循环判断不实际。数组大小 都在3000以上的 如果逐个循环判断不实际。
指点一二。或者给个思路。thanks。
===================
回复：瞧红尘 输出的6就是重复的对应数量吧？
有2个疑问
1.我将数组设置成3000 提示越界。设置成8 也提示越界
2.只改动数组的值 比如将a（3）改成3571 提示越界
2个数组的值是5位数以上的LONG哦。每个数组至少有1000~3000个值日。
你那个程序 貌似 只能处理顺序赋值的 数组呢。
=================
回复 小fisher 你那个QuickSort1D 怎么调用？
Call QuickSort1D(a(999999))？？
先用快速排序法将其中一个排序，再用折半查找法在排序后的数组中依次查找另一个数组中的各个元素，应该只能优化到这样了。
1维数组快速排序算法如下：
Sub QuickSort1D(asArray() As Integer, Optional bSortAscending As Boolean = True, Optional iLow1, Optional iHigh1)
'变量定义
Dim iLow2 As Long, iHigh2 As Long
Dim sKey As Integer
Dim sSwap As Integer
On Error GoTo PtrExit
'如果未给出上下限参数，则排序整个数组
If IsMissing(iLow1) Then iLow1 = LBound(asArray)
If IsMissing(iHigh1) Then iHigh1 = UBound(asArray)
'将将原来的上下限位置值赋给新的上下限位置
iLow2 = iLow1
iHigh2 = iHigh1
'取得上下限之间中间元素的数值
sKey = asArray((iLow1 + iHigh1) \ 2)
'循环遍历上下限之间所有的数组元素
Do While iLow2 < iHigh2
If bSortAscending Then '如果升序排列
'找到第一个大于中间值的元素
Do While asArray(iLow2) < sKey And iLow2 < iHigh1
iLow2 = iLow2 + 1
Loop
'Find the last item that is less than the mid-point item
'找到最后一个小于中间值的元素
Do While asArray(iHigh2) > sKey And iHigh2 > iLow1
iHigh2 = iHigh2 - 1
Loop
Else '如果降序排列
'找到第一个小于中间值的元素
Do While asArray(iLow2) > sKey And iLow2 < iHigh1
iLow2 = iLow2 + 1
Loop
'找到最后一个大于中间值的元素
Do While asArray(iHigh2) < sKey And iHigh2 > iLow1
iHigh2 = iHigh2 - 1
Loop
End If
'如果两个数位置不符合排序要求，则将它们互换
If iLow2 < iHigh2 Then
sSwap = asArray(iLow2)
asArray(iLow2) = asArray(iHigh2)
asArray(iHigh2) = sSwap
End If
'如果上下限未相遇到一起，则继续查找下一个元素
If iLow2 <= iHigh2 Then
iLow2 = iLow2 + 1
iHigh2 = iHigh2 - 1
End If
Loop
'如果是升序排列，按照上面的排序方法排完后，所有大于中间值的元素将全部被分在下半区，
'所有大于中间值的元素将全部被分在上半区，降序排列则反之。
'之后按照同样的规则对上下半区分别进行排序－－递归
If iHigh2 > iLow1 Then QuickSort1D asArray, bSortAscending, iLow1, iHigh2
If iLow2 < iHigh1 Then QuickSort1D asArray, bSortAscending, iLow2, iHigh1
PtrExit:
End Sub
折半查找就比较简单了，就是将数值与排序（假设是升序）后的数组的中间元素进行比较，如果大于中间元素，则向后折半查找，如果小于则向前折半查找，这样复杂度是lg(N)/lg(2)，比遍历查找的复杂度N要小多了
1维数组快速排序算法如下：
Sub QuickSort1D(asArray() As Integer, Optional bSortAscending As Boolean = True, Optional iLow1, Optional iHigh1)
'变量定义
Dim iLow2 As Long, iHigh2 As Long
Dim sKey As Integer
Dim sSwap As Integer
On Error GoTo PtrExit
'如果未给出上下限参数，则排序整个数组
If IsMissing(iLow1) Then iLow1 = LBound(asArray)
If IsMissing(iHigh1) Then iHigh1 = UBound(asArray)
'将将原来的上下限位置值赋给新的上下限位置
iLow2 = iLow1
iHigh2 = iHigh1
'取得上下限之间中间元素的数值
sKey = asArray((iLow1 + iHigh1) \ 2)
'循环遍历上下限之间所有的数组元素
Do While iLow2 < iHigh2
If bSortAscending Then '如果升序排列
'找到第一个大于中间值的元素
Do While asArray(iLow2) < sKey And iLow2 < iHigh1
iLow2 = iLow2 + 1
Loop
'Find the last item that is less than the mid-point item
'找到最后一个小于中间值的元素
Do While asArray(iHigh2) > sKey And iHigh2 > iLow1
iHigh2 = iHigh2 - 1
Loop
Else '如果降序排列
'找到第一个小于中间值的元素
Do While asArray(iLow2) > sKey And iLow2 < iHigh1
iLow2 = iLow2 + 1
Loop
'找到最后一个大于中间值的元素
Do While asArray(iHigh2) < sKey And iHigh2 > iLow1
iHigh2 = iHigh2 - 1
Loop
End If
'如果两个数位置不符合排序要求，则将它们互换
If iLow2 < iHigh2 Then
sSwap = asArray(iLow2)
asArray(iLow2) = asArray(iHigh2)
asArray(iHigh2) = sSwap
End If
'如果上下限未相遇到一起，则继续查找下一个元素
If iLow2 <= iHigh2 Then
iLow2 = iLow2 + 1
iHigh2 = iHigh2 - 1
End If
Loop
'如果是升序排列，按照上面的排序方法排完后，所有大于中间值的元素将全部被分在下半区，
'所有大于中间值的元素将全部被分在上半区，降序排列则反之。
'之后按照同样的规则对上下半区分别进行排序－－递归
If iHigh2 > iLow1 Then QuickSort1D asArray, bSortAscending, iLow1, iHigh2
If iLow2 < iHigh1 Then QuickSort1D asArray, bSortAscending, iLow2, iHigh1
PtrExit:
End Sub
折半查找就比较简单了，就是将数值与排序（假设是升序）后的数组的中间元素进行比较，如果大于中间元素，则向后折半查找，如果小于则向前折半查找，这样复杂度是lg(N)/lg(2)，比遍历查找的复杂度N要小多了
温馨提示：答案为网友推荐，仅供参考
第1个回答 2009-11-09
先排序。
第2个回答 2009-11-09
'不用排序,,...
'循环次数为:第一数组大小 + 第二数组大小 + 值区域
Private Type NumCount
Num1 As Long
Num2 As Long
End Type
' ******************** 计算数组重复率 ********************
' 数组1,数组2,最小值,最大值
'瞧红尘 于[09-11-09 2:48]
Private Function SimilarityArray(a() As Long, b() As Long, ByVal MinNumber As Long, ByVal MaxNumber As Long)
Dim k As Long
Dim k1 As Long
Dim i As Long
Dim p() As NumCount
MaxNumber = MaxNumber - MinNumber
ReDim p(MaxNumber)
For i = 0 To UBound(a)
p(a(i) - MinNumber).Num1 = p(a(i) - MinNumber).Num1 + 1
Next
For i = 0 To UBound(b)
p(b(i) - MinNumber).Num2 = p(b(i) - MinNumber).Num2 + 1
Next
For i = 0 To UBound(p)
k1 = IIf(p(i).Num1 < p(i).Num2, p(i).Num1, p(i).Num2)
k = k + k1
Next
SimilarityArray = k
End Function
'使用方法
Private Sub Form_Load()
Dim a(7) As Long
Dim b(7) As Long
a(0) = 1
b(0) = 10
a(1) = 2
b(1) = 9
a(2) = 3
b(2) = 8
a(3) = 4
b(3) = 7
a(4) = 5
b(4) = 6
a(5) = 6
b(5) = 5
a(6) = 7
b(6) = 4
a(7) = 8
b(7) = 3
Debug.Print SimilarityArray(a, b, 1, 10)
End Sub
'循环次数为:第一数组大小 + 第二数组大小 + 值区域
Private Type NumCount
Num1 As Long
Num2 As Long
End Type
' ******************** 计算数组重复率 ********************
' 数组1,数组2,最小值,最大值
'瞧红尘 于[09-11-09 2:48]
Private Function SimilarityArray(a() As Long, b() As Long, ByVal MinNumber As Long, ByVal MaxNumber As Long)
Dim k As Long
Dim k1 As Long
Dim i As Long
Dim p() As NumCount
MaxNumber = MaxNumber - MinNumber
ReDim p(MaxNumber)
For i = 0 To UBound(a)
p(a(i) - MinNumber).Num1 = p(a(i) - MinNumber).Num1 + 1
Next
For i = 0 To UBound(b)
p(b(i) - MinNumber).Num2 = p(b(i) - MinNumber).Num2 + 1
Next
For i = 0 To UBound(p)
k1 = IIf(p(i).Num1 < p(i).Num2, p(i).Num1, p(i).Num2)
k = k + k1
Next
SimilarityArray = k
End Function
'使用方法
Private Sub Form_Load()
Dim a(7) As Long
Dim b(7) As Long
a(0) = 1
b(0) = 10
a(1) = 2
b(1) = 9
a(2) = 3
b(2) = 8
a(3) = 4
b(3) = 7
a(4) = 5
b(4) = 6
a(5) = 6
b(5) = 5
a(6) = 7
b(6) = 4
a(7) = 8
b(7) = 3
Debug.Print SimilarityArray(a, b, 1, 10)
End Sub
