时间戳

首页 > 解决方案 > 如何更有效地循环？

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

标签： arraysexcelvbaloops

解决方案

尝试类似：

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；我没有测试代码）

编辑1：

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

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

请注意，此代码使用工作表 DB 和报告中的行/列。

另请注意，示例代码中的最后一行表示没有完全限定的范围（例如sheet("report").Rows.Count），这可能是您的问题的一部分。如果活动表（显示的内容）没有行，则您的 rows.count 将其显示为基本范围。

推荐阅读