Ошибка выполнения «1004» при сравнении двух таблиц

Question

Я получаю

ошибка времени '1004' для следующего кода.

Ошибка приложения или объекта для строки

Set rngO = Worksheets(ksWSOriginal).Range(ksOriginal).

У меня проблемы с исправлением ошибки. Я сравниваю две таблицы данных за последний месяц (исходный) и текущий месяц (обновленный), в результате чего все различия будут отображаться на листе "Изменения: *.

Любая помощь приветствуется.

Option Explicit

Sub CompareSheets()
'
' constants
' worksheets & ranges
' original
Const ksWSOriginal = "ORIGINAL"
Const ksOriginal = "OriginalTable"
Const ksOriginalKey = "OriginalKey"
' updated
Const ksWSUpdated = "UPDATED"
Const ksUpdated = "UpdatedTable"
Const ksUpdatedKey = "UpdatedKey"
' changes
Const ksWSChanges = "CHANGES"
Const ksChanges = "ChangesTable"
' labels
Const ksChange = "CHANGE"
Const ksRemove = "REMOVE"
Const ksAdd = "ADD"
'
' declarations
Dim rngO As Range, rngOK As Range, rngU As Range, rngUK As Range, rngC As Range
Dim c As Range
Dim i As Long, J As Long, lChanges As Long, lRow As Long, bEqual As Boolean
'
' start
Set rngO = Worksheets(ksWSOriginal).Range(ksOriginal)
Set rngOK = Worksheets(ksWSOriginal).Range(ksOriginalKey)
Set rngU = Worksheets(ksWSUpdated).Range(ksUpdated)
Set rngUK = Worksheets(ksWSUpdated).Range(ksUpdatedKey)
Set rngC = Worksheets(ksWSChanges).Range(ksChanges)
With rngC
    If .Rows.Count > 1 Then
        Range(.Rows(2), .Rows(.Rows.Count)).ClearContents
        Range(.Rows(2), .Rows(.Rows.Count)).Font.ColorIndex = xlColorIndexAutomatic
        Range(.Rows(2), .Rows(.Rows.Count)).Font.Bold = False
    End If
End With
'
' process
lChanges = 1
' 1st pass: updates & deletions
With rngOK
    For i = 1 To .Rows.Count
        Set c = rngUK.Find(.Cells(i, 1).Value, , xlValues, xlWhole)
        If c Is Nothing Then
            ' deletion
           lChanges = lChanges + 1
            rngC.Cells(lChanges, 1).Value = ksRemove
            For J = 1 To rngO.Columns.Count
                rngC.Cells(lChanges, J + 1).Value = rngO.Cells(i, J).Value
                rngC.Cells(lChanges, J + 1).Font.Color = vbRed
                rngC.Cells(lChanges, J + 1).Font.Bold = True
            Next J
        Else
            bEqual = True
            lRow = c.Row - rngUK.Row + 1
            For J = 1 To rngO.Columns.Count
                If rngO.Cells(i, J).Value <> rngU.Cells(lRow, J).Value Then
                    bEqual = False
                    Exit For
                End If
            Next J
            If Not bEqual Then
                ' change
               lChanges = lChanges + 1
                rngC.Cells(lChanges, 1).Value = ksChange
                For J = 1 To rngO.Columns.Count
   If rngO.Cells(i, J).Value = rngU.Cells(lRow, J).Value Then
      rngC.Cells(lChanges, J + 1).Value = rngO.Cells(i, J).Value
   Else
      rngC.Cells(lChanges, J + 1).Value = rngU.Cells(i, J).Value
      rngC.Cells(lChanges, J + 1).Font.Color = vbMagenta
      rngC.Cells(lChanges, J + 1).Font.Bold = True
   End If
Next J
            End If
        End If
    Next i
End With
' 2nd pass: additions
With rngUK
    For i = 1 To .Rows.Count
        Set c = rngOK.Find(.Cells(i, 1).Value, , xlValues, xlWhole)
        If c Is Nothing Then
            ' addition
           lChanges = lChanges + 1
            rngC.Cells(lChanges, 1).Value = ksAdd
            For J = 1 To rngU.Columns.Count
                rngC.Cells(lChanges, J + 1).Value = rngU.Cells(i, J).Value
                rngC.Cells(lChanges, J + 1).Font.Color = vbBlue
                rngC.Cells(lChanges, J + 1).Font.Bold = True
            Next J
        End If
    Next i
End With
'
' end
Worksheets(ksWSChanges).Activate
rngC.Cells(2, 3).Select
Set rngC = Nothing
Set rngUK = Nothing
Set rngU = Nothing
Set rngOK = Nothing
Set rngO = Nothing
Beep
'
End Sub

Answer 1

Диапазон с именем OriginalTable не существует в рабочем листе с именем Original в вашем случае.Попробуйте что-нибудь простое:

Option Explicit

Sub TestMe()

    Const ksWSOriginal = "Original"
    Dim rngOrange As Range        
    Set rngOrange = Worksheets(ksWSOriginal).Range("OriginalTable")

End Sub

И убедитесь, что оно работает.Ниже вы можете увидеть способ правильного именования именованного диапазона на листе: