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 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

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&" руб."

Sub кмк_скрыть_строки_наличие_0()
 Application.ScreenUpdating = False 'отключение обновление экрана
 Dim c As Range
 LastRow = Cells(Rows.Count, 1).End(xlUp).Row 'последняя заполненная строка в столбце "A"
 For Each c In Range(Cells(3, 1), Cells(LastRow, 1)) 'выбор с 3 до последней заполненной строки, столбца "A"
 If c = 0 Then 'сравнение с нулем
 c.EntireRow.Hidden = True 'скрыть строки с нулем
 ActiveSheet.Shapes("Прямоугольник 4").ZOrder msoBringToFront 'кнопка "показать скрытые строки" на передний план
 End If
 Next
 Application.ScreenUpdating = True 'включение обновление экрана
End Sub

Private Sub Workbook_Open()
Cells(1, 1).Value = ThisWorkbook.Path & "\" & ThisWorkbook.Name
End Sub

Sub Макрос22()
Dim sh As Worksheet, i As Long
Set sh = Sheets("Лист1")
With sh.UsedRange.Columns(2)
     For i = .Rows.Count To 1 Step -1
         With .Cells(i)
             If 0 <= CLng(Trim$(.Value)) And CLng(Trim$(.Value)) <= 100 Then .EntireRow.Delete
         End With
     Next i
End With
End Sub
 

Range(Names("test")).Select

Range(Names("test")).Select
ActiveWindow.SmallScroll Down:=18