Выбор диапазона из набора данных (таблицы Excel) по интервалу дат с помощью VBA для последующей обработки, создания отчетов, анализа данных.
Необходимость выбора диапазона
При ежедневном ведении базы данных (набора данных) в Excel таблица получается очень длинной. Она может содержать информацию о выручке по торговым точкам, о зарплатах сотрудников, о различных видах расходов и т.д.
Анализировать такой набор данных и использовать его в целях учета приходится в разрезе интервалов дат, в соответствии с которыми необходимо осуществить выбор диапазона.
Выбор диапазона из таблицы
Для выбора диапазона из набора данных будем использовать пользовательскую функцию ВыборДиапазона:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 |
Function ВыборДиапазона(ИмяЛиста$, НачальнаяДата$, КонечнаяДата$) As Range Dim МассивДанных As Variant, i&, n1&, n2&, rws&, cls& 'Отлавливаем всевозможные ошибки On Error GoTo ПриОшибке 'Проверяем, чтобы начальная дата не превышала конечную If CDate(НачальнаяДата) > CDate(КонечнаяДата) Then MsgBox "Интервал дат задан неверно!" Exit Function End If With Worksheets(ИмяЛиста).Range("A1").CurrentRegion rws = .Rows.Count cls = .Columns.Count МассивДанных = .Value End With 'Поиск начальной даты For i = 1 To rws If МассивДанных(i, 1) = НачальнаяДата Then n1 = i Exit For End If Next 'Поиск конечной даты For i = rws To 1 Step -1 If МассивДанных(i, 1) = КонечнаяДата Then n2 = i Exit For End If Next 'Проверяем, что границы диапазона определены If n1 = 0 Or n2 = 0 Then MsgBox "Границы диапазона (или одна из границ) заданы неверно!" Exit Function End If Set ВыборДиапазона = Worksheets(ИмяЛиста).Range(Cells(n1, 1), Cells(n2, cls)) Exit Function ПриОшибке: MsgBox "Ошибка: " & Err.Description End Function |
Пример выбора диапазона
Пример использования функции для выбора диапазона с использованием формы для ручного или автоматического заполнения интервала дат:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 |
Private Sub CommandButton6_Click() Dim rng As Range 'Отлавливаем ошибки On Error GoTo ПриОшибке Set rng = ВыборДиапазона("Лист4", TextBox1.Text, TextBox2.Text) If rng Is Nothing Then MsgBox "Диапазон не выбран!" Exit Sub End If 'Строки кода для первоначального тестирования Dim r&, c&, ar, i1&, i2&, txt$ With rng r = .Rows.Count c = .Columns.Count ar = .Value End With For i1 = 1 To r For i2 = 1 To c txt = txt & ar(i1, i2) If i2 = c Then txt = txt & vbNewLine Else txt = txt & "; " End If Next Next Debug.Print txt Exit Sub ПриОшибке: MsgBox "Ошибка: " & Err.Description End Sub |
Примечания
- Формат дат, загружаемых в функцию, должен соответствовать формату дат в наборе данных.
- Код VBA Excel для первоначального тестирования отображает на экране (в окне Immediate) содержимое ячеек выбранного диапазона. Отображаются значения построчно, как в исходном диапазоне, с разделением друг от друга точкой с запятой и пробелом.
- Обратите внимание, что в окне Immediate умещается ограниченное количество знаков — если диапазон большой, все значения могут не поместиться.
- После удачного тестирования, строки кода для первоначального тестирования заменяются на строки кода для обработки выбранного диапазона.