Question

我正在尝试创建一个宏，它允许我比较两个工作表中的数据，并根据任何差异（更新，插入，删除等）进行更新。这就是我到目前为止 - 但它一直被称为查找的线路。我已经阅读了一些有关如何执行此操作的教程，但是无法弄清楚如何在工作表之间调用它并使其正常工作。这是我的代码：

Sub Process()
    'loop through Intermediate sheet
    Dim DataRange As Range, UpdateRange As Range, orig As Range, nov As Range
    Dim lastIntRow As Long, lastDocRow As Long, firstEmptyRow As Long
    lastIntRow = Sheets("Intermediate").Range("A65536").End(xlUp).Row
    lastDocRow = Sheets("Document Library").Range("A65536").End(xlUp).Row
    Set DataRange = Sheets("Intermediate").Range(Sheets("Intermediate").Cells(2, 1), Sheets("Intermediate").Cells(lastIntRow, 1))
    Set UpdateRange = Sheets("Document Library").Range(Sheets("Document Library").Cells(2, 1), Sheets("Document Library").Cells(lastDocRow, 1))
    For Each orig In DataRange
        Set nov = UpdateRange.Find(What:=orig)
            If nov Is Nothing Then
                firstEmptyRow = lastDocRow + 1
                Sheets("Document Library").Cells(firstEmptyRow, 1).Value = orig.Value
                Sheets("Document Library").Cells(firstEmptyRow, 2).Value = Sheets("Intermediate").Cells(orig.Row, 2).Value
                Sheets("Document Library").Cells(firstEmptyRow, 3).Value = Sheets("Intermediate").Cells(orig.Row, 3).Value
            Else:
                Sheets("Document Library").Cells(nov.Row, 2).Value = Sheets("Intermediate").Cells(orig.Row, 2).Value
                Sheets("Document Library").Cells(nov.Row, 3).Value = Sheets("Intermediate").Cells(orig.Row, 3).Value
            End If
    Next
End Sub

非常感谢任何帮助。我真的不确定如何正确地做到这一点，我觉得它变得越来越复杂。谢谢！

Answer 1

Sub Process()
    'loop through Intermediate sheet
    Dim DataRange As Range, UpdateRange As Range, orig As Range, nov As Range
    Dim lastIntRow As Long, lastDocRow As Long, firstEmptyRow As Long
    Dim shtInt As Worksheet, shtDoc As Worksheet
    Dim rw As Range

    'using sheet variables de-clutters your code...
    Set shtInt = ActiveWorkbook.Sheets("Intermediate")
    Set shtDoc = ActiveWorkbook.Sheets("Document Library")

    lastIntRow = shtInt.Range("A65536").End(xlUp).Row
    lastDocRow = shtDoc.Range("A65536").End(xlUp).Row
    firstEmptyRow = lastDocRow + 1 'outside your loop!

    Set DataRange = shtInt.Range(shtInt.Cells(2, 1), shtInt.Cells(lastIntRow, 1))
    Set UpdateRange = shtDoc.Range(shtDoc.Cells(2, 1), shtDoc.Cells(lastDocRow, 1))

    For Each orig In DataRange.Cells

        'be more explicit with "Find()"
        Set nov = UpdateRange.Find(What:=orig, LookIn:=xlValues, lookat:=xlWhole)

        If nov Is Nothing Then
            Set rw = shtDoc.Rows(firstEmptyRow)
            firstEmptyRow = firstEmptyRow + 1 'set next empty...
            rw.Cells(1).Value = orig.Value
        Else
            Set rw = nov.EntireRow
        End If

        rw.Cells(2).Value = orig.Offset(0, 1).Value
        rw.Cells(3).Value = orig.Offset(0, 2).Value

    Next
End Sub

Excel VBA使用“查找”更新不同工作表中的数据

1 个答案: