0

我最近帮助创建了一些检查数据代码，如下所示：

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 格式。有任何想法吗？

4

1 回答 1

0

正如您所说，您的代码没有任何问题，但是我制作了一些模组以使它们的格式与 the 相同，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

事件过程1：

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

事件过程2：

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
于 2013-04-08T11:18:48.580 回答