Установите цвет фона для фиксированного диапазона ячеек

Question

У меня есть код VBA в электронной таблице Excel. Он используется для установки цвета шрифта и фона в ячейке на основе значения в этой ячейке. Я делаю это в 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» текущей строки. В принципе, я хочу фиксированный диапазон, а не динамический.

Answer 1

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