如何更有效地循环?

时间:2019-01-03 12:00:58

标签: arrays excel vba excel-vba loops

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

问题是我要检查另一个范围副本中是否不存在一个范围中的EmployeeID并将其粘贴到第二个范围中。

请查看我的代码。实际上,代码已成功运行,但是出了点问题。我也想问一下如何使此代码更有效地高速运行Loop。其实我尝试过使用数组,但是不知道它是否适当?

谢谢!

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

1 个答案:

答案 0 :(得分:1)

尝试类似的东西:

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和报表中的行/列。

还要注意,示例代码中的最后一行表示形式没有完全限定的范围(例如, sheets(“ report”)。Rows.Count ),这可能是问题的一部分。如果活动表(显示的内容)没有行,则您的rows.count会将其显示为基本范围。