Question

我正在尝试创建一个宏，将以前的支出报告与最新的支出报告进行比较。宏应该从Previous报表中的行中提取数据，并查找包含完全相同数据的Row，然后突出显示两行（在上一个和最新报表中）以显示匹配。这将在当前和以前的报告中不加突出显示差异，以查看是否存在差异（由文档支持）。

我写的代码如下：

Dim CPEAR As String
Dim PPEAR As String
Dim CL As Integer
Dim PL As Integer
Dim DL As Integer

Sub KDPM()
CPEAR = InputBox("Enter Current Pay Cycle (MM/DD/YYYY)", "Current Pay Cycle", , 50, 50)
CPEAR = CDate(CPEAR)
PPEAR = InputBox("Enter Previous Pay Cycle (MM/DD/YYYY)", "Previous Pay Cycle", , 50, 50)
PPEAR = CDate(PPEAR)


PL = 2

Do While Worksheets("PreviousPEAR").Cells(PL, 2).Value = 1
    If Worksheets("PreviousPEAR").Cells(PL, 6).Value = PPEAR Then
        CL = 2
        Do While Worksheets("CurrentPEAR").Cells(CL, 2).Value = 1
            If Worksheets("CurrentPEAR").Cells(CL, 2).Interior.ColorIndex <> 6 Then
                If Worksheets("PreviousPEAR").Cells(PL, 3).Value = Worksheets("CurrentPEAR").Cells(CL, 3) Then
                    If Worksheets("PreviousPEAR").Cells(PL, 4).Value = Worksheets("CurrentPEAR").Cells(CL, 4) Then
                        If Worksheets("PreviousPEAR").Cells(PL, 7).Value = Worksheets("CurrentPEAR").Cells(CL, 7) Then
                            If Worksheets("PreviousPEAR").Cells(PL, 12).Value = Worksheets("CurrentPEAR").Cells(CL, 12) Then
                                If Worksheets("PreviousPEAR").Cells(PL, 14).Value = Worksheets("CurrentPEAR").Cells(CL, 14) Then
                                     Worksheets("CurrentPEAR").Range(Cells(CL, 1), Cells(CL, 21)).Interior.ColorIndex = 6
                                    Worksheets("PreviousPEAR").Range(Cells(PL, 1), Cells(PL, 21)).Interior.ColorIndex = 6
                                    Exit Do
                                End If
                            End If
                        End If
                    End If
                End If
            End If

        CL = CL + 1
        Loop



    End If
PL = PL + 1
Loop

End Sub

它似乎在我的前四行数据中正常工作，但随后它遇到了运行时错误。任何想法？

感谢您的帮助！

Answer 1

正如@BruceWayne在评论中提到的那样，在构建范围时，您需要完全限定对Range，Cells和其他全局对象的所有引用：

Worksheets("PreviousPEAR").Range(Worksheets("PreviousPEAR").Cells(PL, 1), Worksheets("PreviousPEAR").Cells(PL, 21)).Interior.ColorIndex = 6

对于已经很长的代码行和Worksheets集合中的多个查找，这将变得非常繁琐，因此请抓取对工作表的引用和/或将它们放在With块中。这极大地提高了性能：

With Worksheets("PreviousPEAR")
    .Range(.Cells(PL, 1), .Cells(PL, 21)).Interior.ColorIndex = 6
End With

最后，如果要将一堆表达式短路，可以使用Select Case False结构而不是深层嵌套的If语句：

Select Case False
    Case Test1
    Case Test2
    Case Test3
    Case Test4
    Case Else
        Debug.Print "All conditions met"
End Select

这会使你的循环看起来更容易管理......

With Worksheets("PreviousPEAR")
    Dim current As Worksheet
    Set current = Worksheets("CurrentPEAR")
    PL = 2
    Do While .Cells(PL, 2).Value = 1
        If .Cells(PL, 6).Value = PPEAR Then
            CL = 2
            Do While current.Cells(CL, 2).Value = 1
                Select Case False
                    Case current.Cells(CL, 2).Interior.ColorIndex <> 6
                    Case .Cells(PL, 3).Value = current.Cells(CL, 3)
                    Case .Cells(PL, 4).Value = current.Cells(CL, 4)
                    Case .Cells(PL, 7).Value = current.Cells(CL, 7)
                    Case .Cells(PL, 12).Value = current.Cells(CL, 12)
                    Case .Cells(PL, 14).Value = current.Cells(CL, 14)
                    Case Else
                        current.Range(current.Cells(CL, 1), current.Cells(CL, 21)).Interior.ColorIndex = 6
                        .Range(.Cells(PL, 1), .Cells(PL, 21)).Interior.ColorIndex = 6
                        Exit Do
                End Select
            CL = CL + 1
            Loop
        End If
    PL = PL + 1
    Loop
End With

运行Timne错误＆＃39; 1004＆＃39;：突出显示细胞范围

1 个答案: