数组查找不resize

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

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

任何build议如何我可以resize的数组没有代码打破？

谢谢你的帮助！

 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

编辑添加更快的select

你可以避免所有的调光和调光

---

“基地”解决scheme

 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