Sub banksID_JSON_REGEX()
         With CreateObject("msxml2.xmlhttp")
             .Open "get", "http://skad.minfin.ru:8081/OpenDataAPI/api/json/dataset/7710168360-BanksID/version/0/content", 0
             .send
             Dim s$: s = .responsetext
         End With
         With CreateObject("VBScript.RegExp")
             .Global = True
             .Pattern = "([^\\])""+|\\": s = .Replace(s, "$1")
             .Pattern = ",?f\d:": s = .Replace(s, Chr(9) & "@")
             .Pattern = "\[\{|},{|\}\]": s = .Replace(s, vbLf)
             .Pattern = "([\n\r])+\t?|": s = .Replace(s, "$1")
             .Pattern = "(\d{4}-\d{2}-\d{2})T(\d{2})": s = .Replace(s, "$1 $2")
         End With
         With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
             .SetText Mid(s, 2, Len(s) - 2): .PutInClipboard
         End With
         Application.ScreenUpdating = 0: Application.EnableEvents = 0
         With Sheets("Json+RegEx").ListObjects(1)
             If Not .DataBodyRange Is Nothing Then .DataBodyRange.Delete
             .Parent.Activate: .HeaderRowRange(2, 1).Activate
             .Parent.PasteSpecial Format:="Текст"
             .HeaderRowRange = Array("ikb", "name", "ikbstatus", "statusdate")
             .DataBodyRange.Replace "@", Empty, xlPart
         End With
         Application.ScreenUpdating = 1: Application.EnableEvents = 1
End Sub
Sub banksID_JSON_SC()
         Dim s$
         With CreateObject("msxml2.xmlhttp")
             .Open "get", "http://skad.minfin.ru:8081/OpenDataAPI/api/json/dataset/7710168360-BanksID/version/0/content", 0
             .send
             s = .responsetext
         End With
         With CreateObject("ScriptControl")
             .Language = "JScript"
             .AddCode "function getSentenceCount(){return obj.length;}"
             .AddCode "function getSentence(i){return obj[i];}"
             .Eval "var obj=(" & s & ")"
             Dim n&: n = .Run("getSentenceCount") - 1
             Dim i&
             Dim arr
             ReDim arr(0 To n, 0 To 3)
             For i = 0 To n
                 With .Run("getSentence", i)
                     arr(i, 0) = .f1: arr(i, 1) = .f2
                     arr(i, 2) = .f3: arr(i, 3) = Replace(.f4, "T", " ")
                 End With
             Next i
         End With
         Application.ScreenUpdating = 0: Application.EnableEvents = 0
         With Sheets("Json+ScriptControl").ListObjects(1)
             If Not .DataBodyRange Is Nothing Then .DataBodyRange.Delete
             .HeaderRowRange(2, 1).Resize(n + 1, 4).Value = arr
         End With
         Application.ScreenUpdating = 1: Application.EnableEvents = 1
End Sub
Sub banksID_xml()
         With Sheets("xml")
             .QueryTables(1).Refresh 0
             .Parent.XmlMaps("Banks_карта").Import URL:=.[G16]
         End With
End Sub
Sub banksID_Web()
         Application.EnableEvents = 0
         Sheets("Web").QueryTables(1).Refresh 0
         Application.EnableEvents = 1
End Sub
Sub banksID_JSON_PQ()
         ThisWorkbook.Connections("Power Query - Запрос1").Refresh
End Sub

Public FG As MSFlexGridLib.MSFlexGrid, n&, r&
Dim bank$, sc As Object, oXMLHTTP As Object
Sub init()
        Set oXMLHTTP = CreateObject("MSXML2.XMLHTTP")
        Set sc = CreateObject("ScriptControl")
        With sc
            .Language = "JScript"
            .AddCode "function getSentenceCount(){return obj.result.length;}"
            .AddCode "function getSentence(i){return obj.result[i];}"
            .AddCode "function encode(str) {return encodeURIComponent(str);}"
        End With
End Sub
Function RussianStringToURLEncode(ByVal bank_name As String) As String
        RussianStringToURLEncode = sc.Run("encode", bank_name)
End Function
Function GetHTTPResponse(ByVal sURL As String) As String
        On Error Resume Next
        With oXMLHTTP
            .Open "GET", sURL, False
            .send
            GetHTTPResponse = .responsetext
        End With
End Function
Function Readjson(s) As String
        Dim URL As String, itm As Object, k&, str$ ',name
        With sc
            .Eval "var obj=(" & s & ")"
            n = .Run("getSentenceCount")
            If n > 1 Then
                UserForm1.Hide
                FG.TextMatrix(0, 0) = bank
                Do
                    FG.TextMatrix(k + 1, 0) = .Run("getSentence", k).name
                    k = k + 1
                Loop While k < n
                UserForm1.Show
                Set FG = Nothing
            End If
            If n Then
                With .Run("getSentence", r)
                    URL = "http://zakupki.gov.ru/epz/bankguarantee/extendedsearch/search.html?bankSearchItem.title=" & _
                          RussianStringToURLEncode(.name) & "&bankSearchItem.code=" & .cpz & "&bankSearchItem.fz94id=" _
                          & .fz94id & "&bankSearchItem.fz223id=" & .fz223id
                End With
            End If
        End With
        Readjson = URL
End Function
Function zakupki(банк As String)
        Application.Volatile 0
        Dim json As String, URL As String
        bank = банк
        Call init
        With CreateObject("VBScript.RegExp")
            .Global = True
            .Pattern = "[^\""]*\""(.*)\""[^\""]*"
            банк = RussianStringToURLEncode(IIf(.test(банк), .Replace(банк, "$1"), банк))
        End With
        json = GetHTTPResponse("http://zakupki.gov.ru/epz/organization/chooseOrganization/autocompleteReturnsCodes.html?term=" & банк & "&placeOfSearch=&organizationType=BANKS")
        URL = Readjson(json)
        zakupki = Readtotal(GetHTTPResponse(URL))
        Set oXMLHTTP = Nothing
        Set sc = Nothing
End Function
Function Readtotal(ByVal s As String) As Integer
        Dim arr
        If Len(s) Then
            With CreateObject("htmlfile")
                .write Replace(s, "class", "id")
                arr = Split(Replace(Replace(.getElementByid("allRecords").innerhtml, "<", " "), "-", " "), " ")
                With Application
                    Readtotal = .Max(.IfError(.Round(arr, 0), 0))
                End With
            End With
        End If
End Function