Question

我创建了一个excel vba，它可以比较两张纸（界面，步骤）。只要在步骤中找到唯一记录。它将被删除。我想编辑现有代码，而不是删除记录，而应先将其复制到新工作表（第2步），然后再删除它。我是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

我相信您在问您是否可以将值从一个工作表移动到另一个工作表？

请参阅： How do i activate a specific workbook and a specific sheet?

保留一个计数器以记录打开哪一行（用于下一个值）
如果是个人，则：

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

将唯一项目复制到其他工作表，然后在Excel VBA中删除工作表中的项目

1 个答案: