Arrays 如何更有效地循环？

我遇到了一个与循环有关的情况

问题是，我想检查一个范围内的EmployeeID是否在另一个范围内不存在，并将其复制粘贴到第二个范围内

请看我的密码。实际上，代码运行成功，但出现了一些问题。我还想问，如何使这段代码更高效地以高速运行循环。实际上我试着使用数组，但不知道它是否足够合适

提前谢谢

Option Explicit

Sub UniqueWorkerCodeLoop()

Dim i As Integer
Dim j  As Integer
Dim DB As Worksheet:            Set DB = Worksheets("DB")
Dim Report As Worksheet:        Set Report = Worksheets("Report")
Dim Lrow1 As Long:              Lrow1 = DB.Range("A" & Rows.Count).End(xlUp).Row
Dim Lrow2 As Long:              Lrow2 = Report.Range("A" & Rows.Count).End(xlUp).Row
Dim DBTbl As ListObject:        Set DBTbl = DB.ListObjects("Table1")
Dim ReportTbl3 As ListObject:   Set ReportTbl3 = Report.ListObjects("Table3")
Dim DBArray As Variant:         DBArray = DB.ListObjects("Table1").DataBodyRange.Value
Dim ReportArray As Variant:     ReportArray = Report.ListObjects("Table3").DataBodyRange.Value

For i = 1 To UBound(DBArray, 1)
    For j = 1 To UBound(ReportArray, 1)
        If DBArray(i, 1) <> ReportArray(j, 1) Then
            DB.Range("A" & i + 3).Copy
            Report.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
        End If
    Next j
Next i
End Sub

选项显式
子UniqueWorkerCodeLoop（）
作为整数的Dim i
作为整数的Dim j
Dim DB As工作表：设置DB=工作表（“DB”）
Dim报告作为工作表：设置报告=工作表（“报告”）
将Lrow1的长度调整为：Lrow1=DB.Range（“A”和Rows.Count）.End（xlUp）.Row
将Lrow2变长：Lrow2=Report.Range（“A”&Rows.Count）.End（xlUp）.Row
将DBTbl设置为ListObject：设置DBTbl=DB.ListObjects（“表1”）
Dim ReportTbl3作为ListObject：设置ReportTbl3=Report.ListObjects（“表3”）
Dim DBArray作为变量：DBArray=DB.ListObjects（“表1”）.DataBodyRange.Value
Dim ReportArray作为变量：ReportArray=Report.ListObjects（“Table3”）.DataBodyRange.Value
对于i=1到UBound（DBArray，1）
对于j=1到UBound（ReportArray，1）
如果DBArray（i，1）ReportArray（j，1），那么
数据库范围（“A”&i+3）。复制
Report.Range（“A”和Rows.Count）.End（xlUp）.Offset（1,0）.PasteSpecial（xlPasteValues）
如果结束
下一个j
接下来我
端接头

尝试以下方法：

for i = 1 to ubound(DBArray)
    if application.iferror(application.match(DBArray(i,1),ReportArray,0),0)=0 then Report.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).value = DBArray(i,1)
next i

您已经在数组中找到了该值，因此只需将其附加到报告表中，而不是复制/粘贴（我使用了您的行并删除了pastespecial；我没有测试代码）

---

Edit1:

我们将尝试分解信息，以确保提取适当的信息：

Dim i as long, lrs as long, lrd as long, sarr as variant, darr as variant
with sheets("DB")
    lrs = .cells(.rows.count,1).end(xlup).row 'last row source
    sarr = .range(.cells(1,1),.cells(lrs,1)).value 'source array
end with
with sheets("Report")
    lrd = .cells(.rows.count,1).end(xlup).row 'last row destination
    darr = .range(.cells(1,1),.cells(lrd,1)).value 'destination array
    for i = lbound(sarr) to ubound(sarr)
        if application.isna(application.match(sarr(i,1),darr,0)) then
            lrd = .cells(.rows.count,1).end(xlup).row 'last row destination
            .cells(lrd+1,1).value = sarr(i,1)
        end if
    next i
end with

请注意，此代码使用图纸数据库和报表中的行/列

---

还请注意，示例代码中的最后一行表示没有完全限定的范围（例如，sheets（“report”）.Rows.Count），这可能是问题的一部分。如果activesheet（正在显示的内容）没有行，则rows.count将显示该行作为基本范围。

如果您试图将

DBArray

中的1列与1列

ReportArray

进行比较，则可以对

应用程序使用1个循环。对于
循环，匹配
而不是2个
@ShaiRado不是故意抢你的风头的！我也有同样的想法（匹配一维，vlookup表示多维），并在我添加.value而不是copy/paste时发布感谢代码。但目前同样的问题还在继续。在DBArray中，我有EmployeeID和这个动态数组。ReportArray EmployeeID列为空。当我第一次运行代码时，惟一的EmployeeID被传输到ReportArray中。但是，如果我再次运行相同的代码，代码会将相同的ePloyeId带到ReportArray中。我无法解决它。@Khazar是您的数据显示在标准excel电子表格中，它支持列引用等。？您使用的是“表”引用，而不是范围（单元格（1,1）、单元格（lastrow，1）），所以这可能是问题的一部分？我说不出你的桌子是什么。本质上，提供的概念应该符合要求：使用match（）函数确定值是否在某个范围内；当发生错误（即找不到值）时，可以将要匹配的值附加到搜索范围的末尾。搜索范围可以是任何行/列计数。@Khazar更新了帖子，并注意到您的数据中存在一些限定性问题。非常感谢您的支持。您编辑的代码工作正常。我很感激你。