Private Sub Worksheet_Activate()
    Dim ws As Worksheet
    Set ws = ActiveSheet
    Set lo = ws.ListObjects("Table4") '
    
    ' AddHandler lo, "SelectionChange", AddressOf Table4_SelectionChange
       
End Sub

Sub Table4_SelectionChange(ByVal Target As Range)
    MsgBox "The selection in the list object has changed."
End Sub

                         Coll1 |                   Coll2 |                   Coll3 |               Coll4 |      Coll5 |    Coll6 |Coll7|  Coll8 |Coll9| Coll10 
2024-03-21 15:24:36,897 +03:00 | 2024-03-21 15:24:36,897 | 2024-03-21 15:24:36.897 | 2024-03-21 15:24:36 | 2024-03-21 | 15:24:36 | 897 | +03:00 | INF | Messaeg-i - 0
2024-03-21 15:24:38,192 +03:00 | 2024-03-21 15:24:38,192 | 2024-03-21 15:24:38.192 | 2024-03-21 15:24:38 | 2024-03-21 | 15:24:38 | 192 | +03:00 | INF | Messaeg-i - 1
2024-03-21 15:24:39,490 +03:00 | 2024-03-21 15:24:39,490 | 2024-03-21 15:24:39.490 | 2024-03-21 15:24:39 | 2024-03-21 | 15:24:39 | 490 | +03:00 | INF | Messaeg-i - 2
2024-03-21 15:24:40,821 +03:00 | 2024-03-21 15:24:40,821 | 2024-03-21 15:24:40.821 | 2024-03-21 15:24:40 | 2024-03-21 | 15:24:40 | 821 | +03:00 | INF | Messaeg-i - 3
2024-03-21 15:24:40,949 +03:00 | 2024-03-21 15:24:40,949 | 2024-03-21 15:24:40.949 | 2024-03-21 15:24:40 | 2024-03-21 | 15:24:40 | 949 | +03:00 | INF | Messaeg-i - 4

let
    Источник = Csv.Document(File.Contents("E:\Projects\39\01_pr\01\2024-03-21_15-24-36.csv"),
                    [Delimiter="|", 
                    Columns=10, 
                    Encoding=1251]),
    #"Измененный тип" = Table.TransformColumnTypes(Источник,
                    {
                        {"Column1", type text}, 
                        {"Column2", type text}, 
                        {"Column3", type datetime}, 
                        {"Column4", type datetime}, 
                        {"Column5", type date}, 
                        {"Column6", type time}, 
                        {"Column7", Int64.Type}, 
                        {"Column8", type text}, 
                        {"Column9", type text}, 
                        {"Column10", type text}
                    }
                    )
in
    #"Измененный тип"

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("A2:I5")) Is Nothing Then
        On Error Resume Next
        ActiveSheet.ShowAllData
        Range("A7").CurrentRegion.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range("A1").CurrentRegion
    End If
End Sub

 '  --- Data_ListObject ---
Public Sub SelectSqlQuery()
    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim objList As ListObject
    
    Dim strFile As String
    Dim strCon  As String
    Dim strSQL  As String
    Dim s As String
 
    strFile = ThisWorkbook.FullName
    strCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFile & ";Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1"";"
 
    Set cn = CreateObject("ADODB.Connection")
    Set rs = CreateObject("ADODB.Recordset")
 
    cn.Open strCon
    
     Set objList = Sheets("Data_ListObject").ListObjects("TestSQL_tbl")
     s = objList.Range.Address(0, 0)
     
     strSQL = "SELECT * FROM [Data_ListObject$" & s & "]" ' ++
     
     rs.Open strSQL, cn
     Sheets("Result_Range").Range("B3").CopyFromRecordset rs
End Sub

'  --- Data_Range ---
Public Sub SelectSqlQuery2()
    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim objList As ListObject
    
    Dim strFile As String
    Dim strCon  As String
    Dim strSQL  As String
 
    strFile = ThisWorkbook.FullName
    strCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFile & ";Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1"";"
 
    Set cn = CreateObject("ADODB.Connection")
    Set rs = CreateObject("ADODB.Recordset")
 
    cn.Open strCon
    
     strSQL = "SELECT * From [Data_Range$]"
 
    rs.Open strSQL, cn
    Sheets("Result_Range").Range("B3").CopyFromRecordset rs
End Sub

Set FilterRange = Target.Parent.AutoFilter.Range

Private Sub Worksheet_Change(ByVal Target As Range)
 
    Dim FilterCol As Integer
    Dim FilterRange As Range
    Dim CondtitionString As Variant
    Dim Condition1 As String, Condition2 As String
 
    If Intersect(Target, Range("Условия")) Is Nothing Then Exit Sub
 
    On Error Resume Next
    Application.ScreenUpdating = False
     
    'определяем диапазон данных списка
    Set FilterRange = Target.Parent.AutoFilter.Range
     
    'считываем условия из всех измененных ячеек диапазона условий
    For Each cell In Target.Cells
        FilterCol = cell.Column - FilterRange.Columns(1).Column + 1
         
        If IsEmpty(cell) Then
            Target.Parent.Range(FilterRange.Address).AutoFilter Field:=FilterCol
        Else
            If InStr(1, UCase(cell.Value), " ИЛИ ") > 0 Then
                LogicOperator = xlOr
                ConditionArray = Split(UCase(cell.Value), " ИЛИ ")
            Else
                If InStr(1, UCase(cell.Value), " И ") > 0 Then
                    LogicOperator = xlAnd
                    ConditionArray = Split(UCase(cell.Value), " И ")
                Else
                    ConditionArray = Array(cell.Text)
                End If
            End If
            'формируем первое условие
            If Left(ConditionArray(0), 1) = "<" Or Left(ConditionArray(0), 1) = ">" Then
                Condition1 = ConditionArray(0)
            Else
                Condition1 = "=" & ConditionArray(0)
            End If
            'формируем второе условие - если оно есть
            If UBound(ConditionArray) = 1 Then
                If Left(ConditionArray(1), 1) = "<" Or Left(ConditionArray(1), 1) = ">" Then
                    Condition2 = ConditionArray(1)
                Else
                    Condition2 = "=" & ConditionArray(1)
                End If
            End If
            'включаем фильтрацию
            If UBound(ConditionArray) = 0 Then
                Target.Parent.Range(FilterRange.Address).AutoFilter Field:=FilterCol, Criteria1:=Condition1
            Else
                Target.Parent.Range(FilterRange.Address).AutoFilter Field:=FilterCol, Criteria1:=Condition1, _
                    Operator:=LogicOperator, Criteria2:=Condition2
            End If
        End If
    Next cell
     
    Set FilterRange = Nothing
    Application.ScreenUpdating = True
End Sub

Public Sub ReplaceActiveCell()   
    ActiveCell.Value = Replace(ActiveCell.Value, "*", "ok")  
End Sub

SELECT * 
FROM ИнвентарнаяВедомость
WHERE Описание = 'Описание 1'