Главная » Макросы для Excel » Получение кода региона (города) для работы с сервисами Яндекса

Получение кода региона (города) для работы с сервисами Яндекса

Иногда для программного формирования ссылки требуется получить код региона или города, зная его название.
(например, для поиска цен на товары в Яндекс.Маркете в заданном регионе)

К примеру, нужно найти некий товар в Москве, программно сформировав ссылку вида
httр://yandex.ru/yandsearch?text=НазваниеТовара&lr=213,
где 213 - это код города Москвы.

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

Sub ПримерПолученияКодаРегиона()
    КодРегиона1 = GetYandexRegionCode("Москва")    '  КодРегиона1 = 213
    КодРегиона2 = GetYandexRegionCode("Иркутская область")    '  КодРегиона2 = 11266
    КодРегиона3 = GetYandexRegionCode("Европа")    '  КодРегиона3 = 111
    КодРегиона4 = GetYandexRegionCode("Чукотский автономный округ")    '  КодРегиона4 = 10251
    КодРегиона5 = GetYandexRegionCode("Первоуральск")    '  КодРегиона5 = 11171
    
    Debug.Print КодРегиона1, КодРегиона2, КодРегиона3, КодРегиона4, КодРегиона5
End Sub

Функция выполняет запрос по ссылке search.yaca.yandex.ru/geo.c2n
и анализирует результаты ответа, в поисках подходящего региона.
В случае, если регион найден, возвращается его код, или 0, если найти заданный регион не удалось.
Регистр названия региона не учитывается.

Код функции GetYandexRegionCode:

Function GetYandexRegionCode(ByVal RegionName As String) As Long
    On Error Resume Next: Dim txt$
    Set oXMLHTTP = CreateObject("MSXML2.XMLHTTP")
    With oXMLHTTP
        .Open "GET", "http://search.yaca.yandex.ru/geo.c2n", False
        .send: sHTMLBody = .responseBody
    End With
    For i = 0 To UBound(sHTMLBody)
        txt$ = txt$ & ChrW(AscW(Chr(AscB(MidB(sHTMLBody, i + 1, 1)))))
    Next
    Set oXMLHTTP = Nothing
    arr = Split(txt$, vbLf)
    For i = LBound(arr) To UBound(arr)
        region = Split(arr(i), vbTab, 2)(1)
        If LCase(region) = LCase(RegionName) Then
            GetYandexRegionCode = Val(Split(arr(i), vbTab)(0)): Exit Function
        End If
    Next i
End Function

  • 21746 просмотров

Комментарии

Настройки просмотра комментариев

Выберите нужный метод показа комментариев и нажмите "Сохранить установки".
Гость, 28 Фев 2012 - 01:14.#1

Игорь, есть несколько вопросов:

1)
For i = 0 To UBound(sHTMLBody)
txt$ = txt$ & ChrW(AscW(Chr(AscB(MidB(sHTMLBody, i + 1, 1)))))
Next

если у нас в переменной sHTMLBody простой текст (т.е. строка каких-то символов), как мы можем обращаться к этой строке как к массиву и искать у него верхнюю границу через UBound(sHTMLBody) ?

Это тоже самое, что и UBound("какой-то странный код") - что тут выйдет? ОШИБКА!!!
Переменную sHTMLBody нужно сплитить (Split) через какой-то символ или искать в ней нужное через InStr(). Если сплитить, то результат сплита - будет массив и уже его обрабатывать через For Next, а не строку через Ubound()

P.S. Запусти код без On Error Resume Next.

2) и по-моему, нужно писать sHTMLBody = .responseText, а не sHTMLBody = .responseBody

Отправить комментарий

Содержание этого поля является приватным и не предназначено к показу.
CAPTCHA
Подтвердите, пожалуйста, что вы - человек:
   __     ____    _        ____  __        __  _  __
  / /_   |  _ \  | |__    / ___| \ \      / / | |/ /
 | '_ \  | |_) | | '_ \  | |  _   \ \ /\ / /  | ' / 
 | (_) | |  __/  | | | | | |_| |   \ V  V /   | . \ 
  \___/  |_|     |_| |_|  \____|    \_/\_/    |_|\_\
Введите код, изображенный в стиле ASCII-арт.

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

Оформите заказ у нас на сайте, не забыв прикрепить примеры файлов, и описать, что и как должно работать.