Question

我有两个工作表Sheet3和Sheet4。 Sheet3只有A列中的值，Sheet4的值在A列和B列中。

下面的代码为Sheet3创建一维数组，为Sheet4创建一维数组，然后比较两者并在Sheet3列B中输出正确的值。因为代码有点慢，所以我决定调整我的数组大小，现在我的代码不再工作了。

关于如何在没有代码中断的情况下调整数组大小的任何建议？

感谢您的帮助！

Sub ArrayCompare()

Dim Array1() As Variant, Array2() As Variant

ReDim Array1(1 To 1000)

    For i = LBound(Array1) To UBound(Array1)
            Array1(i) = Worksheets("Sheet3").Cells(i, 1).Value
    Next i

ReDim Preserve Array1(1 To i)

ReDim Array2(1 To 1000, 1 To 1000)

    For i = LBound(Array2) To UBound(Array2)
        For j = LBound(Array2, 2) To UBound(Array2, 2)
            Array2(i, j) = Worksheets("Sheet4").Cells(i, j).Value
        Next j
    Next i

ReDim Preserve Array2(1 To i, 1 To j) 'Error occurs here

    For i = LBound(Array1) To UBound(Array1)
        For j = LBound(Array2) To UBound(Array2)
            If Array1(i) = Array2(j, 1) Then

                Worksheets("Sheet3").Cells(i, 2).Value = Array2(j, 2)

            End If
        Next j
    Next i

End Sub

Answer 1

编辑以添加更快的替代方案

您可以避免所有调光和调光

＆＃34; base＆＃34; 解决方案

Option Explicit

Sub ArrayCompare()
    Dim Array1 As Variant, Array2 As Variant

    Array1 = Application.Transpose(Worksheets("Sheet3").Range("A1:A1000")).Value
    Array2 = Worksheets("Sheet4").Range("A1:B1000").Value

    For i = LBound(Array1) To UBound(Array1)
        For j = LBound(Array2) To UBound(Array2)
            If Array1(i) = Array2(j, 1) Then Worksheets("Sheet3").Cells(i, 2).Value = Array2(j, 2)
        Next j
    Next i
End Sub

提升＃1

为了加快速度，你可以避免多次写入工作表，所以：

删除

Worksheets("Sheet3").Cells(i, 2).Value = Array2(j, 2)

来自循环

并放置：

Worksheets("Sheet3").Range("A1:B1000").Value = Array1

正确的

代码变为：

Option Explicit

Sub ArrayCompare1()
    Dim Array1 As Variant, Array2 As Variant
    Dim i As Long, j As Long

    Array1 = Worksheets("Sheet3").Range("A1:B1000").Value
    Array2 = Worksheets("Sheet4").Range("A1:B1000").Value

    For i = LBound(Array1) To UBound(Array1)
        For j = LBound(Array2) To UBound(Array2)
            If Array1(i, 1) = Array2(j, 1) Then Array1(i, 2) = Array2(j, 2)
        Next j
    Next i
    Worksheets("Sheet3").Range("A1:B1000").Value = Array1
End Sub

提升＃2

为了使上述代码更快，您可以将Array1和Array2限制为实际必要的尺寸，而不是使用large足够的尺寸

    Option Explicit

    Sub ArrayCompare2()
        Dim Array1 As Variant, Array2 As Variant
        Dim i As Long, j As Long

        Array1 = GetArray("Sheet3")
        Array2 = GetArray("Sheet4")

        For i = LBound(Array1) To UBound(Array1)
            For j = LBound(Array2) To UBound(Array2)
                If Array1(i, 1) = Array2(j, 1) Then Array1(i, 2) = Array2(j, 2)
            Next j
        Next i
        Worksheets("Sheet3").Range("A1:B1").Resize(UBound(Array1)).Value = Array1
    End Sub

    Function GetArray(shtName As String)
        With Worksheets(shtName)
            GetArray = .Range("B1", .Cells(.Rows.Count, "A").End(xlUp)).Value
        End With
    End Function

数组查找未调整大小

1 个答案: