Skip to content

Instantly share code, notes, and snippets.

@nalgeon nalgeon/README.md
Last active Oct 21, 2019

Embed
What would you like to do?
Пример вызова Подсказок DaData.ru из Excel

Как подключить пример

  1. Откройте Excel и включите отображение вкладки «Разработчик»
  2. Перейдите в редактор Visual Basic (в ленте Разработчик > Visual Basic).
  3. Откройте список ссылок: в меню Tools > References...
  4. Отметьте пункты «Microsoft Scripting Runtime» и «Microsoft VBScript Regular Expressions 5.5». Нажмите OK.
  5. Скачайте архив с библиотекой VBA-JSON. Распакуйте его.
  6. В меню File > Import file... выберите JsonConverter.bas из распакованного архива.
  7. Откройте модуль Лист1.
  8. Скопируйте код из примера в модуль.
  9. Замените значение константы API_KEY с CHANGE_ME на ваш API-ключ.

Как работает пример

Введите название компании или ИНН в ячейку A1, нажмите «энтер». В соседних ячейках появятся реквизиты компании из Подсказок.

Private Const API_KEY = "CHANGE_ME"
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/suggest/" & 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$1" 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("B1").Value = Company("name")("short_with_opf")
Range("C1").Value = Company("ogrn")
Range("D1").Value = Company("inn")
Range("E1").Value = Company("kpp")
Range("F1").Value = Company("okved")
Range("G1").Value = Company("address")("data")("source")
End If
End Sub
@meziniakov

This comment has been minimized.

Copy link

commented Nov 20, 2018

Подскажите, пожалуйста, как изменить код, чтобы можно было в столбце А в каждую ячейку вставлять свой запрос (ИНН), а в соседних ячейках появлялись бы реквизиты компаний из Подсказок?
Спасибо.

@perceff

This comment has been minimized.

Copy link

commented Jan 23, 2019

@meziniakov Скажите как связяться, я могу Вам выслать

@alexuglyov

This comment has been minimized.

Copy link

commented Mar 18, 2019

Аналогичный вопрос, можно ли пример того, как обработать диапазон ячеек?

@bplight

This comment has been minimized.

Copy link

commented Apr 8, 2019

Добрый день. Спасибо nalgeon за код. Для обработки ИНН в столбце А последовательно для каждого ряда мне помогла замена строк 104-117 на:

Function ExtractPostalCode(suggestion) As String
    ExtractPostalCode = Extract("postal_code", suggestion)
End Function
Function ExtractLongitude(suggestion) As String
    ExtractLongitude = Extract("geo_lon", suggestion)
End Function
Function ExtractLatitude(suggestion) As String
    ExtractLatitude = Extract("geo_lat", suggestion)
End Function
Private Sub Worksheet_Change(ByVal Target As Range)
     If Target.Column = 1 Then
        ThisRow = Target.Row
        If Target.Value = Range("A" & ThisRow).Value Then
            Debug.Print "Source: " & Target.Value
            suggested = Suggest("party", Target.Value, 1)
            'Debug.Print "Suggested: " & suggested
            Range("B" & ThisRow).Value = ExtractName(suggested)
            Range("C" & ThisRow).Value = ExtractOGRN(suggested)
            Range("D" & ThisRow).Value = ExtractINN(suggested)
            Range("E" & ThisRow).Value = ExtractKPP(suggested)
            Range("F" & ThisRow).Value = ExtractOKVED(suggested)
            Range("G" & ThisRow).Value = ExtractAddress(suggested)
            Range("H" & ThisRow).Value = ExtractPostalCode(suggested)
            Range("I" & ThisRow).Value = ExtractLongitude(suggested)
            Range("J" & ThisRow).Value = ExtractLatitude(suggested)
         End If
      End If
End Sub

Мне необходимо было на сайте клиента сделать Яндекс карту с метками продаж. Для этих целей понадобились долгота и широта адреса организации: Function ExtractLongitude и Function ExtractLatitude.
Соответственно убирайте/закомментируйте лишние столбцы с данными, если они вам не нужны.

@bplight

This comment has been minimized.

Copy link

commented Apr 8, 2019

Буду благодарна, если кто-то поделится кодом, который позволит единовременно добавлять несколько ИНН в столбец А.

@perceff

This comment has been minimized.

Copy link

commented Jul 22, 2019

@bplight добрый день могу прислать файл с примером, здесь код так не выложишь, т.к. код в трех местах: на сранице, в модуле и в классе.

@BKKRWE

This comment has been minimized.

Copy link

commented Jul 26, 2019

@bplight добрый день могу прислать файл с примером, здесь код так не выложишь, т.к. код в трех местах: на сранице, в модуле и в классе.

А нельзя тут выложить все части кода с указанием мест?

@perceff

This comment has been minimized.

Copy link

commented Jul 29, 2019

не получается, создал проект: https://github.com/perceff/JasonForExcel

@perceff

This comment has been minimized.

Copy link

commented Jul 29, 2019

или выложил на upload ресурс: http://www.unibytes.com/4-q0c-UNQO-Lqw-Us4P3UgBB

@BKKRWE

This comment has been minimized.

Copy link

commented Jul 30, 2019

не получается, создал проект: https://github.com/perceff/JasonForExcel

Спасибо!

@vsokolov7474

This comment has been minimized.

Copy link

commented Sep 2, 2019

День добрый! Подскажите, как в этом примере получить поля
opf.short и name.full

Спасибо!

@RuslanGorin

This comment has been minimized.

Copy link

commented Oct 21, 2019

@nalgeon День добрый! Подскажите пожалуйста как код адаптировать для формы access.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.