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

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

1 个答案: