Sub Макрос1()

 For Each objConnection In ThisWorkbook.Connections
        'Get current background-refresh value
        bBackground = objConnection.OLEDBConnection.BackgroundQuery

        'Temporarily disable background-refresh
        objConnection.OLEDBConnection.BackgroundQuery = False

        'Refresh this connection
        objConnection.Refresh

        'Set background-refresh value back to original value
        objConnection.OLEDBConnection.BackgroundQuery = bBackground
    Next

For Each cell In Range("DistinctValues")
On Error Resume Next
    ActiveWorkbook.Queries.Add Name:=cell.Value, Formula:= _
        "let" & Chr(13) & "" & Chr(10) & "    Источник = Excel.CurrentWorkbook(){[Name=""Таблица""]}[Content]," & Chr(13) & "" & Chr(10) & "    ChangeType = Table.TransformColumnTypes(Источник,{{""№"", Int64.Type}, {""код"", type text}, {""Ограничения"", type text}})," & Chr(13) & "" & Chr(10) & "    ToRows = Table.ToRows(ChangeType)," & Chr(13) & "" & Chr(10) & "    RecordsToRemove = Table.ToRows(#""Задублированные строки"")," & Chr(13) & "" & Chr(10) & "    DuplicatesRemoves = Table.FromRows(List.RemoveMatchin" & _
        "gItems(ToRows,RecordsToRemove), Table.ColumnNames(ChangeType))," & Chr(13) & "" & Chr(10) & "    Filter = Table.SelectRows(DuplicatesRemoves, each ([Ограничения] = """ & cell.Value & """))" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    Filter"
MsgBox Err.Number
On Error GoTo ErrHandler
    ActiveWorkbook.Worksheets.Add
    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
        "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=" & cell.Value & ";Extended Properties=""""" _
        , Destination:=Range("$A$1")).QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM [" & cell.Value & "]")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .ListObject.DisplayName = "_" & Replace(Replace(cell.Value, " ", "_"), ",", "")
        .Refresh BackgroundQuery:=False
    End With
    ActiveSheet.Name = cell.Value
ErrHandler:
'On Error GoTo 0
    Next cell
End Sub

let
    Источник = Table.TransformColumnTypes(Excel.CurrentWorkbook(){[Name="IDGen"]}[Content],{{"From", type text}, {"To", type text}, {"Amount", Int64.Type}}),
    sub = Table.FromList({Text.From(0)..Text.From(9)}&{"A".."Z"}),
    count = Table.AddColumn(Источник, "count", (r)=> 
        [a = List.Generate(
            ()=> [x=0, flag = 0],
            each [flag] <> 1,
            each if Text.Range(r[From], [x], 1) = Text.Range(r[To], [x], 1) 
                 then  [x =[x]+1, flag = 0]
                 else [x =[x], flag = 1],
            each [x]
        ),
         b = List.Count(a)-1,
         c = if b = 0 then 0 else Text.Length(r[From]) - a{b}
        ][c]
    ),
    values = Table.AddColumn(count, "values", (r)=> let cnt = r[count] in   
            if cnt > 1 then 
                 List.Accumulate(
                    {1..r[count]-1},
                    sub,
                    (s,c)=>  
                             let
                                 a = Table.AddColumn(s, "col"&Text.From(c), each sub),
                                 b = Table.ExpandTableColumn(a,"col"&Text.From(c),{"Column1"},{"col"&Text.From(c)}),
                                 d = Table.CombineColumns(b,Table.ColumnNames(b),Combiner.CombineTextByDelimiter("", QuoteStyle.None),"Column1"),
                                 e = Table.AddIndexColumn(d,"index",1,1)
                             in  
                                 e
                                )
            else let
                    a = sub,
                    b = Table.AddIndexColumn(a,"index",1,1)
                 in 
                    b
    ),
    range = Table.AddColumn(values, "ID", (r)=> if r[To] = null then {r[From]} else
                let   
                    tbl = r[values],
                    f = Text.End(r[From],r[count]),
                    l= Text.End(r[To],r[count]),
                    a = {Table.SelectRows(tbl, each [Column1]=f)[index]{0}..Table.SelectRows(tbl, each [Column1]=l)[index]{0}},
                    b = Table.SelectRows(tbl, each List.ContainsAny({_[index]}, a))[Column1],
                    c =  List.Transform(b, each Text.Start(r[From], Text.Length(r[From]) - r[count])&_) 
                in
                    c
    )[[Amount],[ID]],
    exp = Table.ExpandListColumn(range, "ID")
in
    exp

let
    Источник = Table.FromColumns({Lines.FromBinary(File.Contents(path&"Выписка (1).txt"), null, null, 1251)}),
    skip = Table.FirstN(Table.Skip(Источник,4),each [Column1]<>""),
    filtr = Table.SelectRows(skip, each not Text.StartsWith([Column1], "+")),
    f = (x)=>Text.Combine(x[Column1]," "),
// Вот данный шаг gr и хочется воспроизвести через Generate и Accumulate
    gr = Table.Group(filtr,
                    "Column1",
                    {"tmp",f},
                    GroupKind.Local,
                    (s,c)=>  Number.From(List.Count(Text.Split(c,"|"))>=10   ))
                    [[tmp]],
    split = Table.SplitColumn(gr, "tmp", Splitter.SplitTextByDelimiter("|"), 10)
in
    split

= Table.TransformColumns(#"Добавлен пользовательский объект2",{  
      {"Пользовательский.2", each Table.FromList(_, Splitter.SplitByNothing())} 
   }
)

= Table.TransformColumns(Пользовательский1, {
      {"Пользовательский.2", each Table.AddColumn(_, "День недели", each Date.DayOfWeek(_[Column1]))}
   }
)

= Table.TransformColumns(#"Добавлен пользовательский объект3", {
      {"Пользовательский.2", each Table.SelectRows (_,  each [День недели] = 5)}
   }
)

//(file)=>
let   
    //file = "C:\Users\Baranov.Valentin\Desktop\Новая папка (6)\06.2022\20608Rst_BIP.txt",
    EncodingNumber = if Text.Contains(file, "BIP") then 65001 else 1251,
    Source = Csv.Document(File.Contents(file),[Delimiter="|", Encoding=EncodingNumber, Columns = 12, QuoteStyle=QuoteStyle.None]),
    SkipRows = Table.Skip(Source,5),
    Transpose = Table.Transpose(SkipRows),
    CombineColumns = Table.CombineColumns(Transpose,{"Column1", "Column2", "Column3"},Combiner.CombineTextByDelimiter(" ", QuoteStyle.None),"Шапка"),
    СЖПРОБЕЛЫ = Table.TransformColumns(CombineColumns, {"Шапка", СЖПРОБЕЛЫ, type text}),
    TransposeBack = Table.Transpose(СЖПРОБЕЛЫ),
    PromoteHeaders = Table.PromoteHeaders(TransposeBack, [PromoteAllScalars=true]),
    Пользовательская1 = Table.RenameColumns(PromoteHeaders, БылоСтало, MissingField.Ignore),
    SkipRows2 = Table.Skip(Пользовательская1,3),
    RemoveBottomRows = Table.RemoveLastN(SkipRows2,11),
    SelectColumns = Table.SelectColumns(RemoveBottomRows, headers, MissingField.Ignore)
in
    SelectColumns

' Access the GetCursorPos function in user32.dll
      Declare Function GetCursorPos Lib "user32" _
      (lpPoint As POINTAPI) As Long
      ' Access the GetCursorPos function in user32.dll
      Declare Function SetCursorPos Lib "user32" _
      (ByVal x As Long, ByVal y As Long) As Long

      ' GetCursorPos requires a variable declared as a custom data type
      ' that will hold two integers, one for x value and one for y value
      Type POINTAPI
         X_Pos As Long
         Y_Pos As Long
      End Type

      ' Main routine to dimension variables, retrieve cursor position,
      ' and display coordinates
      Sub Get_Cursor_Pos()

      ' Dimension the variable that will hold the x and y cursor positions
      Dim Hold As POINTAPI

      ' Place the cursor positions in variable Hold
      GetCursorPos Hold

      ' Display the cursor position coordinates
      MsgBox "X Position is : " & Hold.X_Pos & Chr(10) & _
         "Y Position is : " & Hold.Y_Pos
      End Sub

      ' Routine to set cursor position
      Sub Set_Cursor_Pos()

      ' Looping routine that positions the cursor
         For x = 1 To 480 Step 20
            SetCursorPos x, x
            For y = 1 To 40000: Next
         Next x
      End Sub

Sub GetDataFromTxtFile(TxtFile As String)
      'TxtConn - соединение с БД (в данном случае БД - текстовый файл)
      'TxtRs - набор записей Recordset
    Dim TxtConn As ADODB.Connection
    Dim TxtRs As ADODB.Recordset
      'DBPath - путь к БД
      'ConnStr - строка подключения к БД
      'LastRow - определение последней строки
    Dim DBPath As String
    Dim ConnStr As String
    Dim LastRow As Long
            
    DBPath = ThisWorkbook.Path
    ConnStr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & DBPath & ";Extended Properties='text;HDR=No;FMT=Delimited';"
 
    Set TxtConn = New ADODB.Connection
    Set TxtRs = New ADODB.Recordset
    
    TxtConn.ConnectionString = ConnStr
                               
    TxtConn.Open
      'закрыть соединение в случае ошибки
    On Error GoTo CloseConnection
                                        
    With TxtRs
        .ActiveConnection = TxtConn
          'SQL-запрос к БД
        .Source = "SELECT * FROM " & "[" & TxtFile & "] " & ""
        .LockType = adLockReadOnly
        .CursorType = adOpenForwardOnly
        .Open
    End With
      'закрыть Recordset в случае ошибки
    On Error GoTo CloseRecordset
      'последняя заполненная строка по столбцу "А"
    LastRow = Cells(Rows.Count, "A").End(xlUp).Row
      'вставляем Recordset ниже последней заполненной строки
    Range("A" & LastRow + 1).CopyFromRecordset TxtRs
      'отключаем обработку ошибок
    On Error GoTo 0
    
CloseRecordset:
    TxtRs.Close
CloseConnection:
    TxtConn.Close
       
End Sub

Sub SQLfromTXT()
 
Dim rs As New ADODB.Recordset
 
DBPath = ThisWorkbook.Path ' в этой папке находится файл txt, являющийся БД.
CnnStr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & DBPath & ";Extended Properties='text;HDR=NO;FMT=TabDelimited(|)'"
SQLString = "SELECT * FROM 10703Rst.txt"
  
rs.Open SQLString, CnnStr
 
With ThisWorkbook.Worksheets(1)
    .Cells(1, 1).CopyFromRecordset rs
End With
 
End Sub

'Option Explicit
 
Public Sub test()
 
'Connection - соединение с базой даннных
'Command - команда DML
'Recordset - набор записей
'Stream - поток двоичных или текстовых данных
'Record -Запись
'нужно подключить библиотеку Microsoft ActiveX Data Object 2.x Library
 
    Dim cn As ADODB.Connection
    Set cn = New ADODB.Connection
    'Source=c:\ -  директория, где хранится файл
    'HDR = YES указывает, что первая строка содержит columnnames, а не данные, HDR = NO; свидетельствует об обратном
        'cn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\Users\valek\Desktop\БД\БДtxt.txt;Extended Properties=""text;HDR=YES;FMT=Delimited"""
        'открыть соединение с базой данных
    cn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\Users\valek\Desktop\БД\;Extended Properties=""text;HDR=YES;IMEX=1;"""
    cn.Open
    Dim rs As ADODB.Recordset
    Set rs = New ADODB.Recordset
    'имя файла к которому идёт обращение "С_помощью_ADO_и_SQL_опрашивать_текстовые_файлы.txt", разделить - ";"
    rs.Open "select * from [БДtxt.txt]", cn
    Debug.Print rs.Fields("Город").Value
    'Debug.Print rs.Fields("Name").Value
    'Debug.Print rs.Fields("Price").Value
 
    rs.Close
    Set rs = Nothing
    cn.Close
    Set cn = Nothing
 
End Sub