ActiveSheet.OLEObjects("CheckBox" & DatePart("m", Now)).Value = True

Private Sub CheckBox10_Click()
      If CheckBox10.Value = True Then GoTo A:
      If CheckBox10.Value = True Then GoTo B:
A:
    For Each cell In ActiveSheet.UsedRange.Rows(1).Cells
        If cell.Value = "x" Then cell.EntireColumn.Hidden = False
    Next
    For Each cell In ActiveSheet.UsedRange.Columns(1).Cells
        If cell.Value = "x" Then cell.EntireRow.Hidden = False
    Next
    
B:
    For Each cell In ActiveSheet.UsedRange.Rows(1).Cells
        If cell.Value = "x" Then cell.EntireColumn.Hidden = True
    Next
    For Each cell In ActiveSheet.UsedRange.Columns(1).Cells
        If cell.Value = "x" Then cell.EntireRow.Hidden = True
    Next
End Sub

Private Sub Workbook_Open()
Application.ScreenUpdating = False
Workbooks.Open Filename:=[я_link_open], ReadOnly:=True
ActiveWorkbook.Windows(1).Visible = False
Application.Calculation = xlCalculationManual
With CreateObject("Shell.Application").Namespace(4).Items
        For n = 1 To .Count - 1
            ИмяПринтераExcel = .Item(n).Name & " (Ne" & Format(n - 1, "00") & ":)"
            If ИмяПринтераExcel Like "*Creator*" Then
                Application.ActivePrinter = ИмяПринтераExcel
                ActivatePDFprinter = True: Exit For
            End If
        Next
    End With
    If Not (Application.ActivePrinter Like "*Creator*") Then
        MsgBox "Не найден виртуальный принтер для печати в ПДФ", vbExclamation
    End If
    If Err Then MsgBox "Не удалось активировать виртуальный принтер для печати в ПДФ", vbExclamation
    Application.ScreenUpdating = True
End Sub

Sub Кнопка1_Щелчок()
Dim FN2 As String
FN2 = ActiveWorkbook.Path & "\Ведомость ПКИ на КРУ-" & ActiveWorkbook.Sheets("ОЛ").Cells(6, 20) & " кВ"
Dim fName
    Application.EnableEvents = 0
    fName = Application.GetSaveAsFilename(InitialFileName:=FN2, fileFilter:="Книга Excel(*.xlsх), *.xlsх")
    If fName <> False Then
       MsgBox "Save as " & fName
        ThisWorkbook.SaveAs fName
    End If
    Application.EnableEvents = -1
    Cancel = True
    
End Sub

=(ЕСЛИ(И(ИНДЕКС(Лист2!$A$1:$R$1873;ПОИСКПОЗ($K$1;Лист2!E:E;0);5)=$K$1;ИНДЕКС(Лист2!$A$1:$R$1873;ПОИСКПОЗ(E8;Лист2!D:D;0);4)=E8);"x";""))

Sub test()
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowInsertingColumns:=False, AllowInsertingRows:=False, _
AllowDeletingColumns:=False, AllowDeletingRows:=False
End Sub

=ЕСЛИ(И(ПОИСКПОЗ($K$3;$E$4:$E$32)=$M$3;ПОИСКПОЗ(B4;$D$4:$D$32)=B4);"x";"з")

Private Sub Worksheet_Change(ByVal Target As Range)

Dim d1 As Object, arr1, el1, i1&, j1&, n1&
If Intersect(Target, [диапазон1]) Is Nothing Then GoTo A
Set d1 = CreateObject("scripting.dictionary")
d1.CompareMode = 0
arr1 = [диапазон1].Value
For Each el1 In arr1
    If Not IsEmpty(el1) Then d1.Item(el1) = d1.Item(el1) + 1 
Next
n1 = Application.Min(Rows.Count - [результат1].Rows(1).Row + 1, UBound(arr1) * UBound(arr1, 2))
Application.ScreenUpdating = False
With [результат1].Resize(n1, 4)
    .ClearContents
    .Columns(1).Resize(d1.Count) = Application.Transpose(d1.Keys) 
    .Columns(4).Resize(d1.Count) = Application.Transpose(d1.Items)
End With

A:
Dim d2 As Object, arr2, el2, i2&, j2&, n2&
If Intersect(Target, [диапазон2]) Is Nothing Then Exit Sub
Set d2 = CreateObject("scripting.dictionary")
d2.CompareMode = 0
arr2 = [диапазон2].Value
For Each el2 In arr2
    If Not IsEmpty(el2) Then d2.Item(el2) = d2.Item(el2) + 1 
Next
n2 = Application.Min(Rows.Count - [результат2].Rows(1).Row + 1, UBound(arr2) * UBound(arr2, 2))
Application.ScreenUpdating = False
With [результат2].Resize(n2, 4)
    .ClearContents
    .Columns(1).Resize(d2.Count) = Application.Transpose(d2.Keys) 
    .Columns(4).Resize(d2.Count) = Application.Transpose(d2.Items) 
End With
End Sub