Выбор записей по критерию через использование объекта Range

Автор: | 12.01.2017

Ниже находится макрос выборки данных по критерию. Перебор строк осуществляется через анализ поля ФИО, так там точно не будет пропусков. В качестве критерия выступает день рождения сотрудника на сегодня в виде 11.11(5 символов), а данные на основном листе располагаются с первой строки, где расположена шапка. Лист для размещения результата изначально отформатирован под лист с основными сведениями, поэтому перенос выбранных сведений происходит начиная со строки два. Строки на листе вставки предварительно очищаются на заданное количество строк, в данном примере на 100. Этим методом можно не только выбирать строки диапазона, объединенные в объект Range,  но и легко удалять. В этом случае мы можем проводить обработку оставшихся сведений, не соответствующему критерию выборки. Пример помогает легко разделить общий список на отдельные листы с информацией по отдельным классам, группам, темам. Пример  легко модифицировать под свои обработки.

Sub Data_rod()
Dim a As String
Dim Data1 As String
Dim FIO As String
Dim Flag As Boolean
Dim RowRange As Range
Flag = False
Begin_Stroka = 2
i = Begin_Stroka
If ActiveSheet.Name <> “Дата_Рождения” Then
Sheets(“Дата_Рождения”).Activate
End If

Rows(“2:100”).Select
Selection.Delete Shift:=xlUp
Range(“A2”).Select

If ActiveSheet.Name <> “Сотрулники” Then
Sheets(“Сотрулники”).Activate
End If

FIO = Cells(i, 1)
Data1 = Mid(CStr(Date), 1, 5)
‘MsgBox Data1

‘Exit Sub
‘RowRange.Select

Do While FIO <> Empty
a = Mid(Cells(i, 3), 1, 5)
If a = Data1 Then
If Flag = False Then
Flag = True
Set RowRange = ActiveSheet.Rows(i)
Else
Set RowRange = Union(RowRange, ActiveSheet.Rows(i))
End If
End If
i = i + 1
FIO = Cells(i, 1)
a = Mid(Cells(i, 3), 1, 5)
Loop
RowRange.Select
RowRange.Copy
Sheets(“Дата_Рождения”).Activate
Range(“A2”).Select

ActiveSheet.Paste
End Sub