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

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

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

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

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

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

 

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

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

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. Организуем примитивный цикл для обработки всех данных:

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

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