Как Loop более эффективно? - PullRequest
0 голосов
/ 03 января 2019

У меня возникла ситуация, связанная с циклом.

Проблема в том, что я хочу проверить, не существует ли 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 голосов
/ 03 января 2019

попробуйте что-то вроде:

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

обратите внимание, что этот код использует строки / столбцы из базы данных листа и отчета.

Также обратите внимание, что ваши последние представления строк в вашем примере кода не имеют полностью определенных диапазонов (например, листов («отчет»). Rows.Count ), которые могут быть частью вашей проблемы. Если в активном листе (что показано) нет строк, то ваш rows.count показывает это как базовый диапазон.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...