如何将此eventproc代码与checkdata代码合并？

Question

我最近被帮助创建了一些checkdata代码，如下所示：

Private Sub Worksheet_Activate()
    CheckData Me.Range("C3:V65")
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
    CheckData Intersect(Target, Me.Range("C3:V65"))
End Sub
Sub CheckData(rng As Range)
    Dim icolor As Integer
    Dim cell As Range

    If rng Is Nothing Then Exit Sub

    For Each cell In rng.Cells
        icolor = 0
        Select Case cell
            Case "": icolor = 2
            Case Is <= Date + 30: icolor = 3
            Case Is <= Date + 60: icolor = 6
            Case Is > Date + 60: icolor = 2
        End Select
        If icolor <> 0 Then cell.Interior.ColorIndex = icolor
    Next cell
End Sub

我在一个工作簿上使用了它，该工作簿实际上只有一个宏需要在指定的范围内运行。但是，我在另一个工作簿中设置了下面的代码，我需要修改该工作簿才能使checkdata函数工作。

Private Sub Worksheet_Change(ByVal Target As Range)
        Application.ScreenUpdating = False
        Application.EnableEvents = False

        EventProc1 Target
        EventProc2 Target

        Application.EnableEvents = True
        Application.ScreenUpdating = True
    End Sub

    Private Sub EventProc1(ByVal Target As Range)
        Dim icolor As Integer
        Dim cell As Range

        If Intersect(Target, Range("L2:L55")) Is Nothing Then Exit Sub
        For Each cell In Target
            icolor = 0
            Select Case cell
                Case "": icolor = 2

                Case Is <= Date + 120: icolor = 3 
                Case Is <= Date + 180: icolor = 6 
                Case Is > Date + 180: icolor = 2

            End Select
            If icolor <> 0 Then cell.Interior.ColorIndex = icolor
        Next cell
    End Sub

    Private Sub EventProc2(ByVal Target As Range)
        Dim icolor As Integer
        Dim cell As Range

        If Intersect(Target, Range("O2:O55")) Is Nothing Then Exit Sub
        For Each cell In Target
            icolor = 0
            Select Case cell
                Case "": icolor = 2

                Case Is <= Date + 30: icolor = 3 
                Case Is <= Date + 60: icolor = 45
                Case Is <= Date + 90: icolor = 6 
                Case Is > Date + 90: icolor = 2 

            End Select
            If icolor <> 0 Then cell.Interior.ColorIndex = icolor
        Next cell
    End Sub

我想我可以像这样合并这两个Worksheet_Change事件：

Private Sub Worksheet_Change(ByVal Target As Range)
        CheckData Intersect(Target, Me.Range("C3:V65"))

        Application.ScreenUpdating = False
        Application.EnableEvents = False

        EventProc1 Target
        EventProc2 Target

        Application.EnableEvents = True
        Application.ScreenUpdating = True
    End Sub

但在这里，我不知道如何将Sub EventProc1/2转换为新的CheckData格式。有什么想法吗？

Answer 1

正如你所说，你的代码没有问题，但我做了几个mod，使它们与checkdata的格式相同，我更喜欢这些，因为你强制颜色的范围并不是硬编码的：

Private Sub Worksheet_Change(ByVal Target As Range)            
    Application.ScreenUpdating = False
    Application.EnableEvents = False

    CheckData Intersect(Target, Me.Range("C3:V65"))

    EventProc1 Intersect(Target, Me.Range("L2:L55"))
    EventProc2 Intersect(Target, Me.Range("O2:O55"))

    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

EventProc1:

Sub EventProc1 (rng As Range)
    Dim icolor As Integer
    Dim cell As Range

    If rng Is Nothing Then Exit Sub

    For Each cell In rng.Cells
        icolor = 0
            Select Case cell
                Case "": icolor = 2                    
                Case Is <= Date + 120: icolor = 3 
                Case Is <= Date + 180: icolor = 6 
                Case Is > Date + 180: icolor = 2           
            End Select
        If icolor <> 0 Then cell.Interior.ColorIndex = icolor
    Next cell
End Sub

EventProc2:

Sub EventProc2 (rng As Range)
    Dim icolor As Integer
    Dim cell As Range

    If rng Is Nothing Then Exit Sub

    For Each cell In rng.Cells
        icolor = 0
            Select Case cell
                Case "": icolor = 2                    
                Case Is <= Date + 30: icolor = 3 
                Case Is <= Date + 60: icolor = 45
                Case Is <= Date + 90: icolor = 6 
                Case Is > Date + 90: icolor = 2            
            End Select
        If icolor <> 0 Then cell.Interior.ColorIndex = icolor
    Next cell
End Sub