Function Unescape$(uStr$)
    With CreateObject("scriptcontrol")
        .Language = "JScript"
        Unescape = .Eval("unescape(""" & uStr & """)")
    End With
End Function

Public WithEvents QTbl As QueryTable
Private Sub QTbl_BeforeRefresh(Cancel As Boolean)
    Dim arr() As Variant, i&, strSQL$, LO As ListObject
    For Each LO In Sheets("Лист1").ListObjects
        i = i + 1
        ReDim Preserve arr(i)
        arr(i) = LO.Range.Address(0, 0, 1, 1)
    Next
    With Application
        arr = .Substitute(.ReplaceB(arr, 1, Len(ThisWorkbook.Name) + 2, ""), "!", "$")
    End With
    strSQL = "select * from (" & Mid(Join(arr, "] union all select * from ["), 13) & "]) where Сумма"
    QTbl.Connection = "ODBC;DSN=Excel Files;DriverId=1046;DBQ=" & Parent.FullName
    QTbl.CommandText = strSQL
End Sub
Private Sub Worksheet_Activate()
    Init
    QTbl.Refresh
End Sub

Private Sub Workbook_Open()
    Call Init
End Sub

Public tbl As QueryTable
Sub Init()
    If tbl Is Nothing Then Set Лист2.QTbl = Лист2.ListObjects(1).QueryTable
    Set tbl = Лист2.QTbl
End Sub

Sub конкретный_лист()
    With ThisWorkbook.Worksheets(1).ListObjects("rngX").AutoFilter
        If .FilterMode Then .ShowAllData
    End With
End Sub

Sub активный_лист()
    With ActiveSheet.ListObjects("rngX").AutoFilter
        If .FilterMode Then .ShowAllData
    End With
End Sub

Sub ChangeProps()
    Dim note$: note = "АБВГ"
    Dim FIO$: FIO = "Иванов"
    With CreateObject("DSOFile.OleDocumentProperties")
        .Open "D:\Шаблон.dwt", , 2
        With .CustomProperties
            On Error Resume Next
            .Add "ФИО", FIO
            .Add "Обозначение", note
            Err.Clear: On Error GoTo 0
            .Item("ФИО") = FIO
            .Item("Обозначение") = note
        End With
            .Save: .Close
    End With
End Sub

Array.apply(null, Array(n)).map(function(_,i){return i+x;})

Sub test()
    Dim shtX As Worksheet
    Dim rngNew As Range
    Dim rngOld As Range
    
    Set shtX = ThisWorkbook.Worksheets(1)
    Set rngNew = shtX.Range("vNew")
    Set rngOld = shtX.Range("vOld")

    If UBound(Filter(Application.CountIf(rngNew, rngOld.Value), 0)) = -1 Then
        MsgBox "значения совпадают"   'если все значения массива совпадают
    Else
        MsgBox "значения различаются" 'если хотя бы одно не совпадает
    End If
    
End Sub

= Excel.CurrentWorkbook(){[Name="Cell"]}[Content]{0}[Column1]

=СЧЁТ(ПОИСК("/*/";A1))=1

=СЧЁТЕСЛИ(A1;"*/*/*")=1

Option Explicit

"," & s

mid(join( ... , ...),2)

String(n," ")

s <> ""

trim(s) <> ""

=ЕСЛИОШИБКА(СУММ(СУММЕСЛИМН(Таб1!$C$2:$C$24;Таб1!$A$2:$A$24;B$1;Таб1!$B$2:$B$24;$A2)^{0;1};-1);"")

Select Case ... End Select

    Select Case Left(s, 1)
        Case "M" 'M англ
            CusOrd = "M1,M2,M3,M4,M5,M6,M7,M8,M9,M10"
        Case "М" 'M русск
            CusOrd = "М1,М2,М3,М4,М5,М6,М7,М8,М9,М10"
    End Select

    f = Left(s, 1)
    Select Case True
        Case f = "M" 'M англ
            CusOrd = "M1,M2,M3,M4,M5,M6,M7,M8,M9,M10"
        Case f = "М" 'M русск
            CusOrd = "М1,М2,М3,М4,М5,М6,М7,М8,М9,М10"
    End Select

CusOrd = Mid(Join(Array(Nil, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10), "," & Left(s, 1)), 2)

Sub sort()
    Dim CusOrd As String
    Dim f As String * 1
    Dim LC As Integer
    Set twb = ActiveSheet 'ActiveWorkbook.Worksheets(1)
    With twb
        LC = .Cells(Rows.Count, 1).End(xlUp).Row
        f = .Range("c1").Value
        Select Case f
            Case "M", "М"
                CusOrd = Mid(Join(Array(Nil, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10), "," & f), 2)
            Case Else
                Exit Sub
        End Select
        .sort.SortFields.Clear
        .sort.SortFields.Add Key:=Range("C1:C" & LC), _
        SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:=CusOrd, DataOption:=xlSortNormal
        With .sort
            .SetRange Range("A1:D" & LC)
            .Header = xlGuess
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    End With
End Sub

        rr = Evaluate("Row(R" & r1 & ":R" & r2 & ")")
        cc = Evaluate("row(R" & c1 & ":R" & c2 & ")")

sortfield.sortonvalue

sortfield.sortonvalue.parent.id