Изменение цвета заливки ячейки в столбце согласно словарю

[Aidarkin]

Помогите знатоки!
Есть макрос изменения цвета шрифта согласно словарю "название"=цвет.
Нужно переделать на изменение цвета ЗАЛИВКИ столбца согласно словарю.

Файл во вложении


___________________________________ ________________________
КОД:

Sub ColorCells()
Application.ScreenUpdating = False
Dim iStart As Integer
Dim rng As Range, cell As Range, sSearchString As String, lastRow&, i&, color&

Set rng = Selection

lastRow = Sheets("ñëîâàðü").[a1000].End(xlUp).Row

For i = 1 To lastRow
If Sheets("ñëîâàðü").Range("A" & i).Interior.ColorIndex <> xlAutomatic Then
color = Sheets("ñëîâàðü").Range("A" & i).Interior.color
Else
color = -65536
End If
sSearchString = Sheets("ñëîâàðü").Range("A" & i).Value

For Each cell In rng
If cell Like "*" & sSearchString & "*" Then
iStart = InStr(cell.Value, sSearchString)
With cell.Characters(Start:=iStart, Length:=Len(sSearchString)).Font
.Bold = True
.color = color
End With
End If

Next
Next

Application.ScreenUpdating = True

[Казанский]

Добавил 1 строку, отключил 5.

Sub ColorCells()
Application.ScreenUpdating = False
    Dim iStart As Integer
    Dim rng As Range, cell As Range, sSearchString As String, lastRow&, i&, color&
    
    Set rng = Selection
    
lastRow = Sheets("словарь").[a1000].End(xlUp).Row

For i = 1 To lastRow
If Sheets("словарь").Range("A" & i).Interior.ColorIndex <> xlAutomatic Then
    color = Sheets("словарь").Range("A" & i).Interior.color
Else
    color = -65536
End If
 sSearchString = Sheets("словарь").Range("A" & i).Value

    For Each cell In rng
        If cell Like "*" & sSearchString & "*" Then
          cell.Interior.color = color
'            iStart = InStr(cell.Value, sSearchString)
'            With cell.Characters(Start:=iStart, Length:=Len(sSearchString)).Font
'                .Bold = True
'                .color = color
'            End With
        End If
   
    Next
    Next

Application.ScreenUpdating = True
End Sub

[Aidarkin]

Спасибо большое! Заработало!)

[Aidarkin]

Хочу закрасить левее ячейку относительно Selection.

Код:

For Each cell In rng
If cell Like "*" & sSearchString & "*" Then
rng.Offset(0, -1).Interior.color = color


Закрашивает столбцы одним последним цветом. По одному правильно закрашивает.Как исправить?

[Aidarkin]

Разобрался

For Each cell In rng
If cell Like "*" & sSearchString & "*" Then

cell.Offset(0, -1).Interior.color = color