2010-04-30 142 views
3

我在Excel電子表格中有VBA代碼。它用於根據該單元格中的值設置單元格的字體和背景顏色。我使用VBA而不是「條件格式」,因爲我有3個以上的條件。代碼是:爲固定範圍的單元格設置背景顏色

Private Sub Worksheet_Change(ByVal Target As Range) 
Dim c As Range, d As Range, fc As Long, bc As Long, bf As Boolean 
Set d = Intersect(Range("A:K"), Target) 
If d Is Nothing Then Exit Sub 
For Each c In d 
    If c >= Date And c <= Date + 5 Then 
     fc = 2: fb = True: bc = 3 
    Else 
     Select Case c 
      Case "ABC" 
       fc = 2: fb = True: bc = 5 
      Case 1, 3, 5, 7 
       fc = 2: fb = True: bc = 1 
      Case "D", "E", "F" 
       fc = 2: fb = True: bc = 10 
      Case "1/1/2009" 
       fc = 2: fb = True: bc = 45 
      Case "Long string" 
       fc = 3: fb = True: bc = 1 
      Case Else 
       fc = 1: fb = False: bc = xlNone 
     End Select 
    End If 
    c.Font.ColorIndex = fc 
    c.Font.Bold = fb 
    c.Interior.ColorIndex = bc 
    c.Range("A1:D1").Interior.ColorIndex = bc 
Next 
End Sub 

問題出在「c.Range」行。它總是使用當前單元格作爲「A」,然後向右移動四個單元格。我希望它在當前行的「真實」單元格「A」中開始,並轉到當前行的「真實」單元格「D」。基本上,我想要一個固定的範圍,而不是一個動態的範圍。

+0

只是爲了驗證,我假設你擔心允許的條件數量,因爲這將被交付給不僅僅是xl2007的用戶? – guitarthrower 2010-04-30 19:30:37

+0

我們使用的Excel 2003似乎只允許3個條件。用戶有6個條件可以測試,包括他們無法在嚮導中工作的日期範圍。 – 2010-04-30 19:53:41

回答

3

所以c.Range("A1:D1")有它自己的相對範圍。
一種解決方法是使用工作表的範圍屬性。
我向頂部添加了兩行(#added),並在底部更改了一行(#changed)。

Private Sub Worksheet_Change(ByVal Target As Range) 
Dim c As Range, d As Range, fc As Long, bc As Long, bf As Boolean 
Dim ws As Worksheet ''#added 

Set d = Intersect(Range("A:K"), Target).Cells 
Set ws = d.Worksheet ''#added 
If d Is Nothing Then Exit Sub 
For Each c In d.Cells 
    If c >= Date And c <= Date + 5 Then 
     fc = 2: bf = True: bc = 3 
    Else 
     Select Case c.Value 
      Case "ABC" 
       fc = 2: bf = True: bc = 5 
      Case 1, 3, 5, 7 
       fc = 2: bf = True: bc = 1 
      Case "D", "E", "F" 
       fc = 2: bf = True: bc = 10 
      Case "1/1/2009" 
       fc = 2: bf = True: bc = 45 
      Case "Long string" 
       fc = 3: bf = True: bc = 1 
      Case Else 
       fc = 1: bf = False: bc = xlNone 
     End Select 
    End If 
    c.Font.ColorIndex = fc 
    c.Font.Bold = bf 
    c.Interior.ColorIndex = bc 
    ws.Cells(c.Row, 1).Interior.ColorIndex = bc ''#changed 
    ws.Cells(c.Row, 2).Interior.ColorIndex = bc ''#added 
    ws.Cells(c.Row, 3).Interior.ColorIndex = bc ''#added 
    ws.Cells(c.Row, 4).Interior.ColorIndex = bc ''#added 
Next 
End Sub 
+0

但是,這設定「第一」行(A 1:D 1)的A至D.我想從「當前」行的A到D.如果我在單元格E7中輸入「5/1/2010」,我希望A7到D7更改。如果我在單元格c99中輸入「5/1/2010」,我想從A99到D99進行更改。基本上,當前列的前四個單元格。 – 2010-04-30 18:36:27

+0

@Count:很棒。修復了這個問題。讓我知道事情的後續。 – bernie 2010-04-30 19:06:58

+0

既然您告訴我「c.Row」是當前行的編號,我將最後四行合併爲一個: ws.Range(「A」&c.Row&「:D」&c.Row) .Interior.ColorIndex = bc 非常感謝。 – 2010-04-30 19:27:25