Макросы VBA в Excel. VBA парсер погоды в качестве примера

Хотите верьте, хотите – нет, а дело было так…

В своей работе на протяжении многих лет мне приходилось для самых разнообразных целей (важных и не очень) пользоваться макросами VBA в Excel.


И хотя я также немного практикуюсь в php (кстати, вот небольшой пример, понятный даже новичку, о том, как вывести двумерный массив в виде таблицы), использование Excel VBA оказалось для меня настоящим кладезем возможностей, позволяющих автоматизировать многие процессы. Недавно руководство компании обратилось ко мне с просьбой (заданием) сделать журнал погоды за последних три года. Дескать, тот, который велся ранее вручную, не соответствует законодательной форме, поскольку его данные не должны расходиться с официальными погодными сайтами.

Не долго чесав репу, по обыкновению, решил применить комплексный подход: Так как программер я не профессиональный, подготовительную часть работы по забору информации с сайта произвел вручную. Ну не делать же бесплатный парсер сайтов, чтобы воспользоваться им только один раз для того, чтобы архив погоды скачать с погодного сайта России или погодного сайта Украины?

Ресурс, с которого я брал журнал погоды гисметео, находится здесь:http://www.gismeteo.ru/diary/
Формат, в который помещались первичные данные, – один файл Excel.Имена листов файла соответствуют году и месяцу, за который копируется журнал. Пример исходных данных для обработки макросом VBA в Excelсмотрите на скриншоте ниже.

 

Excel - исходные данные для журнала погоды
Excel — исходные данные для журнала погоды

Лист для форматирования результатов с помощью макроса VBA

Excel - результирующий лист для журнала погоды
Excel — результирующий лист для журнала погоды

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

  1. Объявляем необходимые переменные:
    Dim stroka_rez, stroka_src As Integer
    stroka_rez = 2
    

    Будет использоваться для удобства две переменные: номер записи результирующий таблицы (начальная вторая строка, т.к. в первой заголовок) и номер записи исходной таблицы. Номер записи результирующей строки будет увеличиваться пока не будут обработаны все листы с исходными данными, а номер записи исходной таблицы будет принимать первоначальное значение, равное 3 в начале каждого цикла для каждого нового листа с исходными данными. О нем немного ниже.

  2. Вторым шагом, который нужно будет выполнить в процессе создания примитивного VBA парсера погоды, является занесение в одномерный массив всех месяцев, за которые взяты данные из архива погоды гисметео:
    Dim arr(1 To 34)
    arr(1) = "2011.10"
    arr(2) = "2011.11"
    arr(3) = "2011.12"
    arr(4) = "2012.01"
    arr(5) = "2012.02"
    arr(6) = "2012.03"
    arr(7) = "2012.04"
    arr(8) = "2012.05"
    arr(9) = "2012.06"
    arr(10) = "2012.07"
    arr(11) = "2012.08"
    arr(12) = "2012.09"
    arr(13) = "2012.10"
    arr(14) = "2012.11"
    arr(15) = "2012.12"
    arr(16) = "2013.01"
    arr(17) = "2013.02"
    arr(18) = "2013.03"
    arr(19) = "2013.04"
    arr(20) = "2013.05"
    arr(21) = "2013.06"
    arr(22) = "2013.07"
    arr(23) = "2013.08"
    arr(24) = "2013.09"
    arr(25) = "2013.10"
    arr(26) = "2013.11"
    arr(27) = "2013.12"
    arr(28) = "2014.01"
    arr(29) = "2014.02"
    arr(30) = "2014.03"
    arr(31) = "2014.04"
    arr(32) = "2014.05"
    arr(33) = "2014.06"
    arr(34) = "2014.07"
  3. Организуем примитивный цикл для обработки всех данных:
  4. For Each s In arr() 'для каждого элемента массива - фактически для каждого нового исходного листа
     stroka_src = 3 'обновить значение начальной строки исходного листа
     Sheets("rez_out").Select
     1 If Len(Sheets(s).Cells(stroka_src, 1)) >= 1 Then 'если в ячейке первого столбца текущей записи есть номер (число месяца)
         If Len(Sheets(s).Cells(stroka_src, 1)) = 2 Then ' И если это значение равно 2 формируем красивую дату
           Cells(stroka_rez, 1).Value = Sheets(s).Cells(stroka_src, 1) & "." & Right(s, 2) & "." & Left(s, 4)
         Else ' в противном случае добавляем ноль перед числом и снова же формируем красивую дату
              Cells(stroka_rez, 1).Value = "0" & Sheets(s).Cells(stroka_src, 1) & "." & Right(s, 2) & "." & Left(s, 4)
         End If
        Cells(stroka_rez, 2).Value = Sheets(s).Cells(stroka_src, 2) ' заполняем температуру
        Cells(stroka_rez, 3).Value = Sheets(s).Cells(stroka_src, 3) ' заполняем давление
        stroka_rez = stroka_rez + 1 'строка результатов увеличивается на 1
        stroka_src = stroka_src + 2 'строка источника увеличивается на 2, т.к. в исходных листах данные находятся на объединенных двух ячейках
        GoTo 1 ' выполняем цикл сначала, пока условие в If Истинно
       Else
       End If
    Next

На этом все. Вот исходный код этого примитивного макроса VBA парсера погоды gismeteo, который разбирает предварительно полученные данные для формирования архива погоды, удобного для себя, и приемлемого для руководства.

Sub pogoda()

Dim stroka_rez, stroka_src As Integer
stroka_rez = 2

Dim arr(1 To 34)
arr(1) = "2011.10"
arr(2) = "2011.11"
arr(3) = "2011.12"
arr(4) = "2012.01"
arr(5) = "2012.02"
arr(6) = "2012.03"
arr(7) = "2012.04"
arr(8) = "2012.05"
arr(9) = "2012.06"
arr(10) = "2012.07"
arr(11) = "2012.08"
arr(12) = "2012.09"
arr(13) = "2012.10"
arr(14) = "2012.11"
arr(15) = "2012.12"
arr(16) = "2013.01"
arr(17) = "2013.02"
arr(18) = "2013.03"
arr(19) = "2013.04"
arr(20) = "2013.05"
arr(21) = "2013.06"
arr(22) = "2013.07"
arr(23) = "2013.08"
arr(24) = "2013.09"
arr(25) = "2013.10"
arr(26) = "2013.11"
arr(27) = "2013.12"
arr(28) = "2014.01"
arr(29) = "2014.02"
arr(30) = "2014.03"
arr(31) = "2014.04"
arr(32) = "2014.05"
arr(33) = "2014.06"
arr(34) = "2014.07"

For Each s In arr() 'для каждого элемента массива - фактически для каждого нового исходного листа
 stroka_src = 3 'обновить значение начальной строки исходного листа
 Sheets("rez_out").Select
 1 If Len(Sheets(s).Cells(stroka_src, 1)) >= 1 Then 'если в ячейке первого столбца текущей записи есть номер (число месяца)
     If Len(Sheets(s).Cells(stroka_src, 1)) = 2 Then ' И если это значение равно 2 формируем красивую дату
       Cells(stroka_rez, 1).Value = Sheets(s).Cells(stroka_src, 1) & "." & Right(s, 2) & "." & Left(s, 4)
     Else ' в противном случае добавляем ноль перед числом и снова же формируем красивую дату
          Cells(stroka_rez, 1).Value = "0" & Sheets(s).Cells(stroka_src, 1) & "." & Right(s, 2) & "." & Left(s, 4)
     End If
    Cells(stroka_rez, 2).Value = Sheets(s).Cells(stroka_src, 2) ' заполняем температуру
    Cells(stroka_rez, 3).Value = Sheets(s).Cells(stroka_src, 3) ' заполняем давление
    stroka_rez = stroka_rez + 1 'строка результатов увеличивается на 1
    stroka_src = stroka_src + 2 'строка источника увеличивается на 2, т.к. в исходных листах данные находятся на объединенных двух ячейках
    GoTo 1 ' выполняем цикл сначала, пока условие в If Истинно
   Else
   End If
Next
EndSub

Как всегда буду рад вашим пожеланиям, замечаниям и здравой критике.

One Reply to “Макросы VBA в Excel. VBA парсер погоды в качестве примера”

  1. Pingback: Как выполнить gem install saas через прокси - Архив системного администратора

Добавить комментарий

Ваш адрес email не будет опубликован. Обязательные поля помечены *

*

Лимит времени истёк. Пожалуйста, перезагрузите CAPTCHA.

Этот сайт использует Akismet для борьбы со спамом. Узнайте как обрабатываются ваши данные комментариев.