Excel VBA-数组为循环指定值

我必须循环搜索多个范围并找到与100k+记录匹配的项。问题是，当将值分配给变量Arr2（I，1）时，我得到了不匹配错误

---

除了@VincentG的注释外，您还需要明确说明正在使用的

行。此外，我还取消了ReDim的注释，它现在似乎正在工作：

Sub t()
Dim Arr0() As Variant, Arr1() As Variant, Arr2() As Variant
Dim Wks0 As Worksheet, Wks1 As Worksheet
Dim i       As Integer
Dim Row0 As Long, Row1 As Long
Dim C       As Object
Set Wks0 = Sheets("HOST")
Set Wks1 = Sheets("OFICI_BANC_USA")

'-- Create array of range -------------------------------------------*
Row0 = Wks0.Cells(Wks0.Rows.Count, "A").End(xlUp).Row
'Arr0 = Wks0.Range("A2:A" & Row0)
Row1 = Wks1.Cells(Wks1.Rows.Count, "A").End(xlUp).Row
Arr1 = Wks1.Range("A2:A" & Row1)

'-- Loop create value on sheet OFIC_BANC_USA found value in sheet HOST -----*
For i = 1 To 5               'UBound(Arr1)
    With Wks0.Range("A2:A" & Row0)
        Set C = .Find(Arr1(i, 1), LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext)
        If Not C Is Nothing Then
            ReDim Preserve Arr2(i, 1)
            Arr2(i, 1) = "OK"
        Else
            Arr2(i, 1) = "NO"
        End If
    End With
Next

' Transpose new array onto worksheet -------------------------------*
Wks1.Range("B2:B6") = WorksheetFunction.Transpose(Arr2)
'Arr0 = Nothing
'Arr1 = Nothing
'Arr2 = Nothing
End Sub

我认为您需要处理来自
wks1
的值的二维数组（因为您在这件事上没有选择），以及在将OK/no值填充回工作表之前保存它们的一维数组

Sub t()
    Dim Arr0() As Variant, Arr1() As Variant, Arr2() As Variant
    Dim Wks0 As Worksheet, Wks1 As Worksheet
    Dim i       As Long
    Dim Row0 As Long, Row1 As Long
    Dim C       As Range

    Set Wks0 = Sheets("HOST")
    Set Wks1 = Sheets("OFICI_BANC_USA")

    '-- Create array of range -------------------------------------------*
    Row0 = Wks0.Cells(Wks0.Rows.Count, "A").End(xlUp).Row
    Row1 = Wks1.Cells(Wks1.Rows.Count, "A").End(xlUp).Row
    Arr1 = Wks1.Range("A2:A" & Row1)

    '-- Loop create value on sheet OFIC_BANC_USA found value in sheet HOST -----*
    For i = 1 To UBound(Arr1, 1)
        With Wks0.Range("A2:A" & Row0)
            Set C = .Find(Arr1(i, 1), LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext)
            ReDim Preserve Arr2(i)  '<~~ NOTE ReDim single dimensioned array here!
            If Not C Is Nothing Then
                Arr2(i) = "OK"
            Else
                Arr2(i) = "NO"
            End If
        End With
    Next

    ' Transpose new array onto worksheet -------------------------------*
    Wks1.Range("B2").Resize(UBound(Arr2), 1) = WorksheetFunction.Transpose(Arr2)

End Sub

OFICI_BANC_USA工作表A列中的200K条记录

主机工作表中每个50K行有4列

约76%的匹配率

14.73秒开始到结束

我想我明白你想做什么了。我把我的两张床单摆成这样：


然后使用以下代码：

Sub jorge()
    Application.ScreenUpdating = False
    Dim Arr1 As Variant, Arr2 As Variant, Arr3 As Variant
    Dim Wks0 As Worksheet, Wks1 As Worksheet
    Dim i As Long, j As Long, k As Long
    Dim Row0 As Long, Row1 As Long

    Set Wks0 = Sheets("HOST")
    Set Wks1 = Sheets("OFICI_BANC_USA")

    '-- Create array of range -------------------------------------------*
    Row0 = Wks0.Cells(Rows.Count, "A").End(xlUp).Row
    Row1 = Wks1.Cells(Rows.Count, "A").End(xlUp).Row
    Arr1 = Wks1.Range("A2:A" & Row1)
    ReDim Arr2(1 To Row1, 1 To 4)
    Arr3 = Wks0.Range("A2:D" & Row0)
    '-- Loop create value on sheet OFIC_BANC_USA found value in sheet HOST -----*
    For i = 1 To UBound(Arr1, 1)
        For j = 1 To UBound(Arr3, 2)
            Arr2(i, j) = "NO"
            For k = 1 To UBound(Arr3, 1)
                If Arr3(k, j) = Arr1(i, 1) Then
                    Arr2(i, j) = "OK"
                    Exit For
                End If
            Next k
        Next j
    Next i

    Wks1.Range("B2").Resize(Row1, 4).value = Arr2
    Application.ScreenUpdating = true
End Sub

我明白了：



这个公式会做同样的事情，把它放在B2中：

=IF(ISNUMBER(MATCH($A2,HOST!A:A,0)),"OK","NO")

来回抄写。这可能会因为计算的数量太多而被禁止，但如果您想尝试的话，它就在这里。
注意，您必须对每个变量使用
作为类型
，而不是对每行仅使用一次，因此在您的代码中，Wks0不是工作表类型。您没有声明Arr2（）的大小。在循环之前，
Redim Arr2（1到5，1到1）
您尚未初始化变量
Arr2（）
，因此无法为其赋值…@Scott Craner，宏管理员-谢谢，不匹配错误是由于赋值前未定义变量Arr2的大小。此错误通过Redim Arr2（1到5，1到1）解决。将Arr2转换到工作表仍然无法显示正确的结果。@Jorge-将
Dim Arr0，Arr1，Arr2作为变量不会出现错误。
唯一的问题是
Arr2
是唯一被明确声明为变量的变量。其他的则被声明为默认值，因为没有给出显式类型（尽管我认为默认值碰巧是变量）。使用上面的代码时，您会在
ReDim Preserve
？？@Jorge处收到一个错误-我假设2D数组是有原因的？你以后会使用
Arr（#，0）
吗？@Jorge-通过“未正确分配”，是否至少分配了数组？如果您使用
F8
单步执行公式，并且它通过
Arr（i，1）=“OK”
行，请键入
？Arr2（1，1）
，然后在即时窗口中单击ENTER键，查看是否显示正确的值。（对于即时窗口，按CTRL+G）。@Jorge-您确定逻辑正确吗？或者您是说
？Arr（5,1）
的即时窗口为“否”，但当您尝试将
Arr2（5,1）
放入单元格时，它会显示“OK”？@Jorge-在将二维数组填充回工作表之前，您不需要转置它。通过转置，您只是用第一个数组元素的值“填充”接收单元格。请注意，我不知道数据的确切范围。有一些限制，通常是工作簿中的列数。另外，我不知道是否需要
LookAt:=xlPart
。如果不是，a可能更好。使用通配符匹配可能更好。@Jeeped-数据范围为Arr1（1到200000，1），匹配范围为Wks0.range（“A2:D50000”）中的4列。好的，这肯定会导致转置过载。现在我不清楚比赛顺序。Wks1！A&B&C&D与Wks0匹配！A&B&C&D？OK/NO值去哪里了？@Jeeped-让我解释一下，Wks1.Range（“A2:A200000”）中充满了唯一的值，我需要找出这些值是否存在于Wks0.Range（“A2:D50000”）中的4列中，然后将结果OK/NO返回到Wks1.Range（“B2:E200000”）中的4列中，这正是我要做的！但是，您的代码会使my excel崩溃：/它太大，无法在工作表上使用公式。有没有不使用Range.Find的原因？@Jorge你说的崩溃是什么意思？它抛出错误，关闭excel，或者excel冻结？@Scott Craner-excel窗口变为白色，必须在任务管理器中终止进程@Jorge As Jeeped给出了一个公认的答案，我不担心，但我稍微修改了代码。如果你再试一次，让它运行，它只是在运行。由于循环的数量太多，这将需要一些时间。@Scott Craner-好的，我仍然会使用您编写的代码。它确实帮助我理解了我的问题。谢谢
Sub jorge()
    Application.ScreenUpdating = False
    Dim Arr1 As Variant, Arr2 As Variant, Arr3 As Variant
    Dim Wks0 As Worksheet, Wks1 As Worksheet
    Dim i As Long, j As Long, k As Long
    Dim Row0 As Long, Row1 As Long

    Set Wks0 = Sheets("HOST")
    Set Wks1 = Sheets("OFICI_BANC_USA")

    '-- Create array of range -------------------------------------------*
    Row0 = Wks0.Cells(Rows.Count, "A").End(xlUp).Row
    Row1 = Wks1.Cells(Rows.Count, "A").End(xlUp).Row
    Arr1 = Wks1.Range("A2:A" & Row1)
    ReDim Arr2(1 To Row1, 1 To 4)
    Arr3 = Wks0.Range("A2:D" & Row0)
    '-- Loop create value on sheet OFIC_BANC_USA found value in sheet HOST -----*
    For i = 1 To UBound(Arr1, 1)
        For j = 1 To UBound(Arr3, 2)
            Arr2(i, j) = "NO"
            For k = 1 To UBound(Arr3, 1)
                If Arr3(k, j) = Arr1(i, 1) Then
                    Arr2(i, j) = "OK"
                    Exit For
                End If
            Next k
        Next j
    Next i

    Wks1.Range("B2").Resize(Row1, 4).value = Arr2
    Application.ScreenUpdating = true
End Sub

=IF(ISNUMBER(MATCH($A2,HOST!A:A,0)),"OK","NO")