- Откройте Excel и включите отображение вкладки «Разработчик»
- Перейдите в редактор Visual Basic (в ленте Разработчик > Visual Basic).
- Откройте список ссылок: в меню Tools > References...
- Отметьте пункты «Microsoft Scripting Runtime» и «Microsoft VBScript Regular Expressions 5.5». Нажмите OK.
- Скачайте архив с библиотекой VBA-JSON. Распакуйте его.
- В меню File > Import file... выберите JsonConverter.bas из распакованного архива.
- Откройте модуль Лист1.
- Скопируйте код из примера в модуль.
- Замените значение константы API_KEY с CHANGE_ME на ваш API-ключ.
Введите название компании или ИНН в ячейку A1, нажмите «энтер». В соседних ячейках появятся реквизиты компании из Подсказок.
Я адаптировала под свои значения. но скажите как растянуть на столбец? у меня большая база
Function Suggest(ByVal name, ByVal query, ByVal count) As Object
Dim http
Set http = CreateObject("WinHttp.WinHttpRequest.5.1")
timeout = 2000 'milliseconds
http.setTimeouts timeout, timeout, timeout, timeout
request = "{ ""query"": """ & query & """, ""count"": """ & count & """ }"
http.Open "POST", "https://suggestions.dadata.ru/suggestions/api/4_1/rs/findById/" & name
http.SetRequestHeader "Content-Type", "application/json"
http.SetRequestHeader "Authorization", "Token " & API_KEY
http.Send request
Debug.Print http.ResponseText
Set Suggest = JsonConverter.ParseJson(http.ResponseText)
End Function
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
If Target.Address = "$A$2" Then
Debug.Print "Source: " & Target.Value
Dim Suggestions As Object
Set Suggestions = Suggest("party", Target.Value, 1)
Dim Company As Object
Set Company = Suggestions("suggestions")(1)("data")
Range("B2").Value = Company("name")("short_with_opf")
Range("C2").Value = Company("branch_count")
Range("D2").Value = Company("employee_count")
Range("E2").Value = Company("employee_count")
End If
End Sub