Sub St()
    Dim URL$, txt As String, clid As String, lang As String, vspid As String, data As String, id As String
    clid = "594"
    lng = "en"
    vspid = "1"
    data = "#2_1,3_800,22_7,5_1493800,9_match,8_1181210054,178_53405,7_53403"
    URL = "https://vfl3.betradar.com/s4/?clientid=" & clid & "&language=" & lng & "&vsportid=" & vspid & data
    txt = DownloadText(URL)
    id = Split(Split(txt, "id"":""")(1), """,")(0)
    URL = "https://vfl3.betradar.com/s4/gismo.php?&id=" & id & "&language=" & lng & "&clientid=" & clid & "&vsportid=" & vspid & "&state=" & data
    txt = DownloadText(URL)
    Cells(1, 1) = txt
End Sub
Private Function DownloadText(ByVal URL As String) As String
    With CreateObject("Microsoft.XMLHTTP")
        .Open "GET", Replace(URL$, "\", "/"), "False"
        .setRequestHeader "If-Modified-Since", "Thu, 1 Jan 1970 00:00:00 UTC"
        .setRequestHeader "Content-Type", "text/html; charset=utf-8"
        .send
        If .statustext = "OK" Then DownloadText = .responseText
    End With
End Function

Sub Upd()

MsgBox("Start!")

Sub Upd()
    ActiveWorkbook.RefreshAll
    Application.OnTime Now + TimeValue("00:00:07"), "Upd"
End Sub

XMLHTTP.SetRequestHeader "If-Modified-Since", "Thu, 1 Jan 1970 00:00:00 UTC"

Function postj(ByVal URL$, ByVal json As String) As String
    With CreateObject("Microsoft.XMLHTTP")
        .Open "POST", Replace(URL$, "\", "/"), "False"
        .setRequestHeader "If-Modified-Since", "Thu, 1 Jan 1970 00:00:00 UTC"
        .setRequestHeader "Content-Type", "application/json; charset=utf-8"
        .setRequestHeader "Accept-Language", "ru-RU"
        .send (json)
        If .statustext = "OK" Then postj = .responseText
    End With
End Function

    With CreateObject("Scripting.FileSystemObject").OpenTextFile("D:\test.html", 1, True)
        txt = .ReadAll: .Close
    End With
    txt = Replace(Replace(txt, Chr(10), ""), Chr(13), "")
    txt = Split(Split(txt, "Features:</strong>")(1), "/p>")(0)
    With CreateObject("VBScript.RegExp")
        .Global = True: .IgnoreCase = True: .Pattern = ">(.+?)<"
        If .test(txt) Then
            Set Matches = .Execute(txt)
            If Matches.Count > 0 Then
                For m = 0 To Matches.Count - 1
                    Cells(m + 1, 1) = Matches(m).SubMatches(0)
                Next
            End If
        End If
    End With

    Dim arr() As Variant
    Dim txt As String
    arr = Application.Transpose(Range("a1:a293"))
    txt = Join(arr)
    Erase arr
    With CreateObject("VBScript.RegExp")
        .Global = True
        .Pattern = "(\d){11}"
        If .test(txt) Then
            Set Matches = .Execute(txt)
            If Matches.Count > 1 Then
                ReDim arr(Matches.Count - 1)
                For i = 0 To Matches.Count - 1
                    arr(i) = Matches(i)
                Next
                ActiveSheet.Range("B1").Resize(Matches.Count, 1) = Application.Transpose(arr)
            End If
        End If
    End With

    Dim i As Long
    Dim t As Double
    'Dim sorted As Variant
    Randomize
    With CreateObject("System.Collections.ArrayList")
        For i = 0 To 1999999
          .Add Format$(Int(Rnd * 2000000), "0000000")
        Next
        t = Timer
        .Sort
        'sorted = .ToArray
        Debug.Print Timer - t
    End With

select 
   g.[Дата создания], 
   g.[Принято в работу], 
   g.[Выполнено], 
   g.[Описание задачи],
   (select [Сотрудник] from [users] u where u.[Код]=g.[Для кого]) as [Для кого], 
   (select [Сотрудник] from [users] u where u.[Код]=g.[Кто создал]) as [Кто создал]
from [general] g

SELECT c.[col1] FROM (SELECT a.F1 AS col1 FROM [Список_1$] AS a UNION SELECT b.F1 AS col2 FROM [Список_2$] AS b) c WHERE IsNumeric(c.[col1]) = True

Function EncodeBase64(text As String) As String
    Dim arr() As Byte
    arr = StrConv(text, vbFromUnicode)
    With CreateObject("MSXML2.DOMDocument").CreateElement("b64")
        .DataType = "bin.Base64"
        .nodeTypedValue = arr
        EncodeBase64 = .text
    End With
End Function