Скопируйте уникальные элементы на другой лист и удалите элемент на листе в Excel VBA.

Question

Я создал Excel vba, который сравнивает два листа (Интерфейс, Шаги). Всякий раз, когда уникальная запись найдена в шагах. Это будет удалено. Я хотел отредактировать существующий код таким образом, чтобы вместо удаления записей он сначала копировался на новый лист (Steps2), а затем удалялся. Я довольно новичок в VBA, я включил код ниже. Я не хочу использовать функцию копирования и вставки, так как выполнение занимает много времени. Я ищу, чтобы создать со словарем сценариев. Любая помощь мне в достижении результата поможет мне.

Option Explicit

Function UpdateOLD() As Long
'     This Sub will do the Following Update
'     Run through all records in OLD
'        if found in Interface  ---> Do nothing
'        if not found in Interface ----> Delete it from Steps.
Application.ScreenUpdating = False
Dim Rng As Range
Dim WSO As Worksheet
Dim WSN As Worksheet
Dim MaxRowO As Long, MaxRowN As Long, I As Long, J As Long, lDel As Long
Dim sJob As String, sOps As String, sFirstAddress As String
Dim cCell As Range
Dim bNotFound As Boolean


'---> Disable Events
With Application
    .EnableEvents = False
    .DisplayAlerts = False
    .ScreenUpdating = False
End With

'---> Set Variables
Set WSO = Sheets("Steps")
Set WSN = Sheets("Interface")
MaxRowO = WSO.Range("A" & WSO.Rows.Count).End(xlUp).Row
MaxRowN = WSN.Range("C" & WSN.Rows.Count).End(xlUp).Row
WSO.Range("N2:N" & MaxRowO).ClearContents

'---> Loop thruough all rows in sheet New
For I = 2 To MaxRowO
    bNotFound = False
    sJob = WSO.Cells(I, "B")
    sOps = WSO.Cells(I, "C")
    Set cCell = WSN.Range("D6:D" & MaxRowN).Find(what:=sJob, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
    If Not cCell Is Nothing Then
        bNotFound = True
        sFirstAddress = cCell.Address
        Do
            '---> Check to See if Ops if found for that Job
            If WSN.Cells(cCell.Row, "E") = sOps Then
                bNotFound = False
                Exit Do
            End If
            Set cCell = WSN.Range("D6:D" & MaxRowN).FindNext(cCell)
        Loop While Not cCell Is Nothing And cCell.Address <> sFirstAddress
    Else
        bNotFound = True
    End If

    '---> Del Record from OLD if Not Found
    If bNotFound Then
        If Rng Is Nothing Then
        Set Rng = WSO.Range("A" & I)
        Else
        Set Rng = Union(Rng, WSO.Range("A" & I))
        lDel = lDel + 1
        End If
    End If
Next I

If Not Rng Is Nothing Then Rng.EntireRow.Delete

'---> Enable Events
With Application
    .EnableEvents = True
    .DisplayAlerts = True
    .ScreenUpdating = True
End With

UpdateOLD = lDel

End Function

Answer 1

Я полагаю, что вы спрашиваете, можете ли вы перенести значения с одного листа на другой?

См .: Как активировать определенную книгу и конкретный лист?

• Вести счетчик, чтобы записать, какая строка открыта (для следующего значения)
• Если это физическое лицо, то:

wb1.Sheets("SourceSheet").Cells(row, columnNumber).Value = wb1.Sheets("OutputSheet").Cells(counter, columnNumber).Value