求关于对两组数组对比、更新的优化方案

ddd_shawen

请高手帮忙看一下以下代码，能否告诉我是否还有其他更快更好的方法。
Option Base 1


Sub Text()
    Dim A()
    Dim B()
    ReDim A(88000, 5)
    ReDim B(6000, 5)
    '----------------------------------------
    ' 中间给A，B数组赋值的代码省略
    '----------------------------------------
    For x = 1 To 6000
        For y = 1 To 88000
        '------------------------------------------------------------------------------------------------------
            If A(y, 1) = B(x, 1) Then    ' 假设两组数组中的第一项内容相同，则将B数组中的数据更新值A数组中
                For J = 1 To 5
                    A(y, J) = B(x, J)  ' 赋值
                Next J
                Exit For         ' 更新好一个数组就退出当前循环
            End If
        '------------------------------------------------------------------------------------------------------
        Next y
    Next x
End Sub


不知道我的问题是否提的明白？如果看不明白的话，我再解释!

lb_bn

建议楼主用字典。

ddd_shawen

我对Dictionary的使用还不是很熟悉，感觉Dictionary中object.Add key, item的 “Item”是不是只能添加一条项目？
而我的每条数组的内容共有5项，不知道要如何添加好。
不知道能否指导一下呢？
谢谢了！

ddd_shawen

希望高手能帮我优化以下下面更新A数组的代码
Option Base 1

Sub 测试用代码()
    Application.ScreenUpdating = False
    StartTime = Timer
    Dim A()
    Dim B()
    ReDim A(88000, 5)
    ReDim B(6000, 5)
    '----------------------------------------
    ' 以下假设给A，B数组分别赋值
    For t = 1 To 88000
        For J = 1 To 5
            A(t, J) = t
        Next J
    Next t
    For K = 1 To 6000
        For J = 1 To 5
            B(K, J) = Int((88000 * Rnd) + 1)
        Next J
    Next K
    '-------------------------------------------------
     ' 以下是将更新A数组
    For x = 1 To 6000
        For y = 1 To 88000
        '-----------------------------------------------------------------------------------------------------------------            If A(y, 1) = B(x, 1) Then    ' 假设两组数组中的第一项内容相同，则将B数组中的数据更新值A数组中
                For J = 1 To 5
                    A(y, J) = B(x, J)  ' 赋值
                Next J
                Exit For         ' 更新好一个数组就退出当前循环
            End If
        '-----------------------------------------------------------------------------------------------------------------
        Next y
    Next x
     '-------------------------------------------------
    EndTime = Timer
    Application.ScreenUpdating = True
    MsgBox "该程序运行共花时: " & Format(EndTime - StartTime, "0.00000000") & "秒"
End Sub

lb_bn

Option Base 1
Sub bbb()
    Dim i&, ii&, tt#
    Dim A()
    Dim B()
    ReDim A(88000, 5)
    ReDim B(6000, 5)
   
    tt = Timer
   
    For i = 1 To 88000
        For ii = 1 To 5
            A(i, ii) = i
        Next
    Next
    For i = 1 To 6000
        For ii = 1 To 5
            B(i, ii) = Int((88000 * Rnd) + 1)
        Next
    Next


    Set dic1 = CreateObject("scripting.dictionary")
    For i = 1 To UBound(A)
        If Not dic1.exists(A(i, 1)) Then
            dic1(A(i, 1)) = i
        End If
    Next
    For i = 1 To UBound(B)
        If dic1.exists(B(i, 1)) Then
            For ii = 1 To 5
                B(i, ii) = A(dic1(B(i, 1)), ii)
            Next
        End If
    Next
   
    MsgBox Timer - tt
    [a23].Resize(UBound(B), 5).Value = B
   
   
End Sub

[ 本帖最后由 lb_bn 于 2010-3-22 00:12 编辑 ]

lb_bn

反了，更新A里的，更快。

Option Base 1
Sub bbb()
    Dim i&, ii&, tt#
    Dim A()
    Dim B()
    ReDim A(88000, 5)
    ReDim B(6000, 5)
   
    tt = Timer
   
    For i = 1 To 88000
        For ii = 1 To 5
            A(i, ii) = i
        Next
    Next
    For i = 1 To 6000
        For ii = 1 To 5
            B(i, ii) = Int((88000 * Rnd) + 1)
        Next
    Next


    Set dic1 = CreateObject("scripting.dictionary")
    For i = 1 To UBound(B)
        If Not dic1.exists(B(i, 1)) Then
            dic1(B(i, 1)) = i
        End If
    Next
    For i = 1 To UBound(A)
        If dic1.exists(A(i, 1)) Then
            For ii = 1 To 5
                A(i, ii) = B(dic1(A(i, 1)), ii)
            Next
        End If
    Next
   
    MsgBox Timer - tt
   
End Sub

ddd_shawen

真的是太感谢你了！
向你学习！！！

谢谢了！！！