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

并确保其有效。在下面，您可能会看到在工作表中正确命名命名范围的方法：

比较两个工作表的运行时错误'1004'

1 个答案: