Arrays 数组查找未调整大小

我有两张工作表

Sheet3

和

Sheet4

<代码>表3仅在A列中有值，

表4

在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

---

编辑以添加更快的备选方案

您可以避免所有的调光和重拨

---

基本解决方案

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

---

Boost#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

---

Boost#2

为了使上述代码更快，您可以将

Array1

和

Array2

限制为实际需要的大小，而不是使用足够大的

大小

    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

编辑以添加更快的备选方案

您可以避免所有的调光和重拨


基本解决方案

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


Boost#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


Boost#2

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

    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

您只能重拨多维数组的最后一个维度首先查找数据范围的维度，然后重拨数组OK，因此将
reDim Preserve Array2（1到i，1到j）
更改为
reDim Preserve Array2（1到j）
将解决第一个问题？您是否考虑过执行
Array1=Application.Transpose（工作表（“Sheet3”）.Range（“A1”，工作表（“Sheet3”）.Cells（工作表（“Sheet3”）.Rows.Count，“A”）.End（xlUp））.Value）
（假设您希望获取A列中的所有单元格）和
Array2=工作表（“Sheet4”）.Range（“A1”，工作表（“Sheet4”）.Cells（工作表（“Sheet4”）.Rows.Count”，B”）.End（xlUp））.Value
（假设Array2是包含a列和B列的二维数组）注意：在当前代码中，
i
和
j
都将在发生
ReDim
s的点处具有值1001。您只能重拨多维数组的最后一个维度首先查找数据范围的维度，然后重拨数组OK，因此更改
ReDim Preserve Array2（1到i，1到j）
到
ReDim Preserve Array2（1到j）
将是第一个问题的解决方案？您是否考虑过使用
Array1=Application.Transpose（工作表（“Sheet3”）.Range（“A1”，工作表（“Sheet3”）.Cells（工作表（“Sheet3”）.Rows.Count，“A”）.End（xlUp））.Value）
（假设您希望获得A列中的所有单元格）和
Array2=工作表（“Sheet4”）.Range（“A1”，工作表（“Sheet4”）.Cells（工作表（“Sheet4”）.Rows.Count，“B”）.End（xlUp））.Value
（假设Array2是包含a列和B列的二维数组）注意：在您当前的代码中，
i
和
j
在发生
ReDim
s的点上都有1001的值。谢谢@user3598756，这工作得很好！但是它和我尝试调整数组大小之前的代码一样快。我知道这不是我的问题的一部分，但是我可以在e方面做些什么吗加快查找速度的效率？我的印象是，调整数组大小将提高使用数组的效率。@VBAPete您想将数组大小调整为什么？目前，您的原始代码只是试图将其大小调整为
（1到1001）
和
（1到1001，1到1001）
它比它们开始时稍微大一点，但代码中没有任何东西表明您真的在试图使它们变小。如果您只是试图调整它们的大小，使它们只包含非空单元格，那么在读取它们时比在创建它们后更容易做到这一点。@VBAPete-您可以，但是（根据我对问题本身的评论，这与user3598756的回答类似，只是用
End（xlup）
键入最后一行计算替换
1000
）只需读取所需信息并允许VBA设置大小就更容易了-无需循环获取数据（这会很慢），以后无需计算数组的大小等。（但我的评论仅在您尝试调整数组大小，使其与数据中的非空单元格具有相同的行时有效。如果您正在执行其他操作，则不起作用。）VBAPete和@YowE3K，请参阅编辑后的答案，其中我添加了两个不同的“boost”级别处理YowE3k关于限制数组大小的建议，并在其中添加从循环中删除工作表写入的操作。OP的原始代码仅在某些单元格中存储值。如果某些未更新的单元格包含公式（我强调它们可能不包含公式），再次从数组中写入整个范围将用值替换这些公式。@VBAPete需要在实施这些“增强”之前检查这是否是一个问题。（注意，我喜欢您将这些增强命名为“增强”。）谢谢@user3598756这工作得很好！但它和我尝试调整数组大小之前的代码一样快。我知道这不是我的问题的一部分，但在效率方面我能做些什么来加快查找？我的印象是，调整数组大小会提高效率。@VBAPe