Skip to content

Instantly share code, notes, and snippets.

@nalgeon nalgeon/README.md
Last active Jan 3, 2020

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

meziniakov commented Nov 20, 2018

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

@perceff

This comment has been minimized.

Copy link

perceff commented Jan 23, 2019

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

@alexuglyov

This comment has been minimized.

Copy link

alexuglyov commented Mar 18, 2019

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

@bplight

This comment has been minimized.

Copy link

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 commented Apr 8, 2019

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

@perceff

This comment has been minimized.

Copy link

perceff commented Jul 22, 2019

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

@BKKRWE

This comment has been minimized.

Copy link

BKKRWE commented Jul 26, 2019

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

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

@perceff

This comment has been minimized.

Copy link

perceff commented Jul 29, 2019

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

@perceff

This comment has been minimized.

Copy link

perceff commented Jul 29, 2019

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

@BKKRWE

This comment has been minimized.

Copy link

BKKRWE commented Jul 30, 2019

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

Спасибо!

@vsokolov7474

This comment has been minimized.

Copy link

vsokolov7474 commented Sep 2, 2019

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

Спасибо!

@RuslanGorin

This comment has been minimized.

Copy link

RuslanGorin commented Oct 21, 2019

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

@Shock922

This comment has been minimized.

Copy link

Shock922 commented Nov 4, 2019

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

@ouroukov

This comment has been minimized.

Copy link

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 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 commented Jan 3, 2020

@ouroukov

This comment has been minimized.

Copy link

ouroukov commented Jan 3, 2020

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.