如何將此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 

但是，從這裏，我不知道如何分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