Skip to content

Instantly share code, notes, and snippets.

@nalgeon
Last active Feb 3, 2021
Embed
What would you like to do?
Пример вызова Подсказок DaData.ru из Excel

Пример вызова Подсказок 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

@meziniakov meziniakov commented Nov 20, 2018

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

@perceff

This comment has been minimized.

Copy link

@perceff perceff commented Jan 23, 2019

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

@alexuglyov

This comment has been minimized.

Copy link

@alexuglyov alexuglyov commented Mar 18, 2019

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

@bplight

This comment has been minimized.

Copy link

@bplight bplight 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

@bplight bplight commented Apr 8, 2019

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

@perceff

This comment has been minimized.

Copy link

@perceff perceff commented Jul 22, 2019

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

@BKKRWE

This comment has been minimized.

Copy link

@BKKRWE BKKRWE commented Jul 26, 2019

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

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

@perceff

This comment has been minimized.

Copy link

@perceff perceff commented Jul 29, 2019

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

@perceff

This comment has been minimized.

Copy link

@perceff perceff commented Jul 29, 2019

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

@BKKRWE

This comment has been minimized.

Copy link

@BKKRWE BKKRWE commented Jul 30, 2019

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

Спасибо!

@vsokolov7474

This comment has been minimized.

Copy link

@vsokolov7474 vsokolov7474 commented Sep 2, 2019

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

Спасибо!

@RuslanGorin

This comment has been minimized.

Copy link

@RuslanGorin RuslanGorin commented Oct 21, 2019

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

@Shock922

This comment has been minimized.

Copy link

@Shock922 Shock922 commented Nov 4, 2019

@perceff @nalgeon а можно вывести дату присвоения ОГРНИП? Если да то как, заранее спасибо
И если можно добавить в этом коде? https://github.com/perceff/JasonForExcel

@ouroukov

This comment has been minimized.

Copy link

@ouroukov ouroukov commented Dec 9, 2019

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

{
  "suggestions": [
    {
      "value": "ООО ХЛЕБОРОБ",
      "unrestricted_value": "ООО ХЛЕБОРОБ",
      "data": {
        "kpp": "644901001",
        "capital": null,
        "management": {
          "name": "Федоров Владимир Михайлович",
          "post": "ДИРЕКТОР",
          "disqualified": null
        },
        "founders": null,
        "managers": null,
        "branch_type": "MAIN",
        "branch_count": 0,
        "source": null,
        "qc": null,
        "hid": "5581e9e02ce11f9995c34ba8dcbc524144ba6c6ce7243043715117fb36c2116e",
        "type": "LEGAL",
        "state": {
          "status": "ACTIVE",
          "actuality_date": 1546300800000,
          "registration_date": 855619200000,
          "liquidation_date": null
        },
        "opf": {
          "type": "2014",
          "code": "12300",
          "full": "Общество с ограниченной ответственностью",
          "short": "ООО"
        },
        "name": {
          "full_with_opf": "ОБЩЕСТВО С ОГРАНИЧЕННОЙ ОТВЕТСТВЕННОСТЬЮ ХЛЕБОРОБ",
          "short_with_opf": "ООО ХЛЕБОРОБ",
          "latin": null,
          "full": "ХЛЕБОРОБ",
          "short": "ХЛЕБОРОБ"
        },
        "inn": "6404002815",
        "ogrn": "1026400555675",
        "okpo": null,
        "okved": "46.21.11",
        "okveds": null,
        "authorities": null,
        "documents": null,
        "licenses": null,
        "finance": {
          "tax_system": null,
          "income": null,
          "expense": null,
          "debt": null,
          "penalty": null
        },
        "address": {
          "value": "Саратовская обл, г Энгельс, ул Марины Расковой, д 4",
          "unrestricted_value": "413121, Саратовская обл, г Энгельс, ул Марины Расковой, д 4",
          "data": {
            "postal_code": "413121",
            "country": "Россия",
            "country_iso_code": null,
            "federal_district": null,
            "region_fias_id": "df594e0e-a935-4664-9d26-0bae13f904fe",
            "region_kladr_id": "6400000000000",
            "region_iso_code": null,
            "region_with_type": "Саратовская обл",
            "region_type": "обл",
            "region_type_full": "область",
            "region": "Саратовская",
            "area_fias_id": null,
            "area_kladr_id": null,
            "area_with_type": null,
            "area_type": null,
            "area_type_full": null,
            "area": null,
            "city_fias_id": "c58d0505-54eb-4c34-8216-b14f7cdb0ecb",
            "city_kladr_id": "6400001300000",
            "city_with_type": "г Энгельс",
            "city_type": "г",
            "city_type_full": "город",
            "city": "Энгельс",
            "city_area": null,
            "city_district_fias_id": null,
            "city_district_kladr_id": null,
            "city_district_with_type": null,
            "city_district_type": null,
            "city_district_type_full": null,
            "city_district": null,
            "settlement_fias_id": null,
            "settlement_kladr_id": null,
            "settlement_with_type": null,
            "settlement_type": null,
            "settlement_type_full": null,
            "settlement": null,
            "street_fias_id": "9b203331-73b8-4141-8c16-8d56aa021976",
            "street_kladr_id": "64000013000023400",
            "street_with_type": "ул Марины Расковой",
            "street_type": "ул",
            "street_type_full": "улица",
            "street": "Марины Расковой",
            "house_fias_id": "c7ad9d3c-6fca-40f6-acc4-8bf2eb09f0ef",
            "house_kladr_id": "6400001300002340096",
            "house_type": "д",
            "house_type_full": "дом",
            "house": "4",
            "block_type": null,
            "block_type_full": null,
            "block": null,
            "flat_type": null,
            "flat_type_full": null,
            "flat": null,
            "flat_area": "429.0",
            "square_meter_price": "29032",
            "flat_price": "12454728",
            "postal_box": null,
            "fias_id": "c7ad9d3c-6fca-40f6-acc4-8bf2eb09f0ef",
            "fias_code": "64000013000000002340096",
            "fias_level": "8",
            "fias_actuality_state": "0",
            "kladr_id": "6400001300002340096",
            "geoname_id": null,
            "capital_marker": "0",
            "okato": "63450000000",
            "oktmo": "63650101001",
            "tax_office": "6449",
            "tax_office_legal": "6449",
            "timezone": "UTC+4",
            "geo_lat": "51.4807044",
            "geo_lon": "46.1396026",
            "beltway_hit": null,
            "beltway_distance": null,
            "metro": null,
            "qc_geo": "0",
            "qc_complete": null,
            "qc_house": null,
            "history_values": null,
            "unparsed_parts": null,
            "source": "413113, ОБЛАСТЬ САРАТОВСКАЯ, ГОРОД ЭНГЕЛЬС, УЛИЦА МАРИНЫ РАСКОВОЙ, ДОМ 4",
            "qc": "0"
          }
        },
        "phones": null,
        "emails": null,
        "ogrn_date": 1041292800000,
        "okved_type": "2014",
        "employee_count": null
      }
    }
  ]
}

@sergslip

This comment has been minimized.

Copy link

@sergslip sergslip commented Jan 2, 2020

хотел применить код к базе банков по бик . Не получается что не так?

Screenshot_2

мой код
Private Const API_KEY = "------------------------------"

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/bank" & 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")
Range("C1").Value = Company("correspondent_account")

        Range("d1").Value = Company("bic")
        
        'Range("q1").Value = Company("state")("status")
        'Range("r1").Value = Company("type")


End If

End Sub

@ouroukov

This comment has been minimized.

Copy link

@ouroukov ouroukov commented Jan 3, 2020

@ouroukov

This comment has been minimized.

Copy link

@ouroukov ouroukov commented Jan 3, 2020

@Alexander-Belo

This comment has been minimized.

Copy link

@Alexander-Belo Alexander-Belo commented Feb 21, 2020

Пробовал прикрутить к экселю, однако ничего не работает не подскажите в чем дело?

@Alexander-Belo

This comment has been minimized.

Copy link

@Alexander-Belo Alexander-Belo commented Feb 21, 2020

Привет! Ну ты додумался 2-го января писать! Я в некондиции до 9-го ;-) Высылаю тебе рабочий прототип, покопайся пока в нем, копирайта нет, т.к. все это безнадежно устарело 1-го января. Если есть какие вопросы, то пиши 9-го. А по ошибке: переменная или свойство имеет неверный тип. Например, переменная целого типа, не может принимать строковые значения, которые не распознаются как целые числа Открой дебаггер и посмотри типы переменных или пришли мне сам файл, я посмотрю, у меня чет не правильно копируется в проект. чт, 2 янв. 2020 г. в 11:14, sergslip notifications@github.com:

хотел применить код к базе банков по бик . Не получается что не так? [image: Screenshot_2] https://user-images.githubusercontent.com/59432455/71655561-3e4a7000-2d2f-11ea-85d5-2645068374b1.jpg мой код Private Const API_KEY = "------------------------------" 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/bank" & 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") Range("C1").Value = Company("correspondent_account") Range("d1").Value = Company("bic") 'Range("q1").Value = Company("state")("status") 'Range("r1").Value = Company("type") End If End Sub — You are receiving this because you commented. Reply to this email directly, view it on GitHub https://gist.github.com/b5d0c7b72bb6b393475ae67e73c86ed3?email_source=notifications&email_token=AF72YZWAMDXPMDJ63CIZY4TQ3WH63A5CNFSM4IFV6LO2YY3PNVWWK3TUL52HS4DFVNDWS43UINXW23LFNZ2KUY3PNVWWK3TUL5UWJTQAF6X6G#gistcomment-3125219, or unsubscribe https://github.com/notifications/unsubscribe-auth/AF72YZVPVV6DSDQZWPU6ZK3Q3WH63ANCNFSM4IFV6LOQ .

То есть данный код устарел и уже не работает?

@ouroukov

This comment has been minimized.

Copy link

@ouroukov ouroukov commented Feb 21, 2020

@Alexander-Belo

This comment has been minimized.

Copy link

@Alexander-Belo Alexander-Belo commented Feb 21, 2020

Сейчас очень занят, не могу вплотную заняться. Как я понял ошибка в строке Range("d1").Value = Company("bic")? Type mismatch это ошибка несоответствия типов переменных Попробуй перед местом возникновения ошибки вывести значение в MsgBox() или посмотри значение в дебаггере. Если там цифры то переведи в строку CStr()

Снимок1
Снимок2

@ouroukov

This comment has been minimized.

Copy link

@ouroukov ouroukov commented Feb 21, 2020

@Elpomena

This comment has been minimized.

Copy link

@Elpomena Elpomena commented May 26, 2020

А подскажите пожалуйста, что за формат даты выгружается? Мне очень нужна дата регистрации, но там какие-то огромные значения. Как переформировать?
Спасибо

@ouroukov

This comment has been minimized.

Copy link

@ouroukov ouroukov commented May 27, 2020

А подскажите пожалуйста, что за формат даты выгружается? Мне очень нужна дата регистрации, но там какие-то огромные значения. Как переформировать?
Спасибо

https://ru.wikipedia.org/wiki/Unix-%D0%B2%D1%80%D0%B5%D0%BC%D1%8F
http://i-leon.ru/tools/time
Не?

@cosstaman

This comment has been minimized.

Copy link

@cosstaman cosstaman commented Jun 25, 2020

Подскажите, а как можно изменить код, что бы еще отоброжались ближайшие станции метро? ООооочень надо!

@danielDefo007

This comment has been minimized.

Copy link

@danielDefo007 danielDefo007 commented Feb 2, 2021

Подскажите, что сделал не так?

@nalgeon почему не работает. Я вставил в А1 ИНН и ничего выдает ошибку.
Снимок экрана 2021-02-01 в 18 57 07

@nalgeon

This comment has been minimized.

Copy link
Owner Author

@nalgeon nalgeon commented Feb 2, 2021

@danielDefo007 какую ошибку? На скриншоте ее не видно.

@danielDefo007

This comment has been minimized.

Copy link

@danielDefo007 danielDefo007 commented Feb 2, 2021

@danielDefo007 какую ошибку? На скриншоте ее не видно.

Снимок экрана 2021-02-03 в 2 05 27
Снимок экрана 2021-02-03 в 2 05 45

@nalgeon

This comment has been minimized.

Copy link
Owner Author

@nalgeon nalgeon commented Feb 3, 2021

@danielDefo007 возможно, вы не подключили JsonConverter.bas по инструкции?

@danielDefo007

This comment has been minimized.

Copy link

@danielDefo007 danielDefo007 commented Feb 3, 2021

@danielDefo007 возможно, вы не подключили JsonConverter.bas по инструкции?Подключил, на рис это видно.
Снимок экрана 2021-02-03 в 11 57 45

@danielDefo007

This comment has been minimized.

Copy link

@danielDefo007 danielDefo007 commented Feb 3, 2021

может ли это быть из за неактивированной учетной записи Excel?

@danielDefo007

This comment has been minimized.

Copy link

@danielDefo007 danielDefo007 commented Feb 3, 2021

@danielDefo007 возможно, вы не подключили JsonConverter.bas по инструкции?

попробовал на другом компьютере, получилось, а как расширить перечень подтягиваемых данных? Есть ли возможность сделать
image

@danielDefo007

This comment has been minimized.

Copy link

@danielDefo007 danielDefo007 commented Feb 3, 2021

чтобы эти поля подтягивались максимально возможно

@danielDefo007

This comment has been minimized.

Copy link

@danielDefo007 danielDefo007 commented Feb 3, 2021

@danielDefo007 какую ошибку? На скриншоте ее не видно.

Я также добавлю, что я делаю в Excel MAC через Parallels и видимо конвертор JsonConverter.bas не срабатывает. Может ли это быть если я использую 64 или 32 бит версию? как это проверить? из зачего может быть ошибка?

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment