Private Sub Установить_заливку(CrossRange As Range)
    Dim objFormCond As Object, i As Long
    For i = Me.Cells.FormatConditions.Count To 1 Step -1
        Set objFormCond = Me.Cells.FormatConditions(i)
        If objFormCond.Type = xlExpression Then 'application-defined or object-defined error
            If objFormCond.Formula1 = "=1" Then 'application-defined or object-defined error
                objFormCond.ModifyAppliesToRange CrossRange
                Exit For
            End If
        End If
    Next
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim WorkRange As Range
    'адрес рабочего диапазона подсветки
    Set WorkRange = Range("A4:M35")
    'если активная ячейка в рабочем диапазоне и нет УФ: добавить УФ
    If WorkRange.Address = Union(WorkRange, ActiveCell).Address And ActiveCell.FormatConditions.Count = 0 Then
        i = ActiveCell.Address(0, 0)
        MyFormula = "=ИЛИ(И(ЯЧЕЙКА(""строка"")=СТРОКА(" & i & ");ЯЧЕЙКА(""столбец"")<>СТОЛБЕЦ(" & i & "));И(ЯЧЕЙКА(""строка"")<>СТРОКА(" & i & ");ЯЧЕЙКА(""столбец"")=СТОЛБЕЦ(" & i & ")))"
        WorkRange.FormatConditions.Add Type:=xlExpression, Formula1:=MyFormula
        WorkRange.FormatConditions(WorkRange.FormatConditions.Count).SetFirstPriority
        With WorkRange.FormatConditions(1).Interior
            .PatternColorIndex = xlAutomatic
            .Color = 5296274
            .TintAndShade = 0
        End With
        WorkRange.FormatConditions(1).StopIfTrue = False
    End If
    ActiveCell.Calculate
End Sub

"=ИЛИ(И(ЯЧЕЙКА(""строка"")=СТРОКА(" & i & ");ЯЧЕЙКА(""столбец"")<>СТОЛБЕЦ(" & i & "));И(ЯЧЕЙКА(""строка"")<>СТРОКА(" & i & ");ЯЧЕЙКА(""столбец"")=СТОЛБЕЦ(" & i & ")))"

Range("CH:DE,DF:EC").ColumnWidth = 6

Sub полный()
Set Rng = Columns("C:C").Find("полный")

Rng.Offset(, 4) = Round(Rng.Offset(, 4) + 1000)
Rng.Offset(, 5) = Round(Rng.Offset(, 5) + 1000)

End Sub

Sub ОпределитьЦветЗаливкиАктивнойЯчейки()
    MsgBox ActiveCell.Interior.Color
End Sub

Sub НайтиБелыйЦветЗаливки()
Dim rng As Range
For Each rng In ActiveSheet.UsedRange.Cells
    If rng.Interior.ThemeColor = xlThemeColorDark1 And rng.Interior.TintAndShade = 0 Then
        MsgBox "цвет заливки: (Белый, Фон 1) " & rng.Address(0, 0)
        rng.Interior.ThemeColor = xlNone
        MsgBox "цвет заливки: Нет заливки"
    End If
Next rng
End Sub

Sub Макрос1()
With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorDark1
    .TintAndShade = 0
    .PatternTintAndShade = 0
End With
End Sub

Sub НайтиБелыйЦветЗаливки()
Dim rng As Range
For Each rng In ActiveSheet.UsedRange.Cells
If rng.Interior.ThemeColor = xlThemeColorDark1 Then
    MsgBox "цвет заливки: Белый, Фон 1"
    rng.Interior.ThemeColor = xlNone
    MsgBox "цвет заливки: Нет заливки"
End If
Next rng
End Sub

'цвет заливки: Белый, Фон 1
With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorDark1
    .TintAndShade = 0
    .PatternTintAndShade = 0
End With
    
'цвет заливки: Нет заливки
With Selection.Interior
    .Pattern = xlNone
    .TintAndShade = 0
    .PatternTintAndShade = 0
End With

Sub Test()
  Dim n As Double
  With ActiveWindow
    n = .UsableWidth
    .DisplayHeadings = False
    Debug.Print "Ширина заголовка строк ", .UsableWidth - n
    .DisplayHeadings = True
  End With
End Sub

Set w = ActiveWindow
MsgBox w.Width

Declare Function GetSystemMetrics32 Lib "user32" Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long
Public Const SM_CXVSCROLL = 2
Sub ShowVScrollWidth()
    Dim lVScrollWidth As Long
    lVScrollWidth = GetSystemMetrics32(SM_CXVSCROLL)
    MsgBox lVScrollWidth
End Sub

Sub Макрос1()
last_cell = Cells(Rows.Count, 1).End(xlUp).Row
Range("B" & last_cell).FormulaR1C1 = "=SUM(R3C:R[-1]C)"
End Sub

="Всего наименований "&A1&","&" на сумму "&ТЕКСТ(B1;"0,00")&" руб."

="Всего наименований "&A1&","&" на сумму "&B1&" руб."