Выборка в excel средствами VBA

Формулировка задачи:

Добрый времени суток, товарищи Профессионалы! Прошу Вас помощи в нелегкой мне задачи! Я совсем не силен в тонкостях VBA! Объясняю мою проблему! Есть книга Excel, нужно: на отдельном листе сделать выборку с листа "ТЕСТ". Оставить: - последнее звание - последнюю должность при увольнении - посчитать периоды службы - выделить цветом сотрудников, которым когда-либо было присвоено звание рядовой - должно работать на любом количестве сотрудников Если можно составить такой макрос с пояснениями. Поскольку выборка штатными средствами типа сортировки - не вариант. Заранее благодарен Вам!!!

Решение задачи: «Выборка в excel средствами VBA»

textual
                            Листинг программы 
                        
 
                            
                        
Sub Выборка_данных()
    Dim i&, j&, k&, q&, LastRow&, A, S$, ArStolbcy, SrokY%, SrokM%, SrokD%, Date2 As Date
    A = Worksheets("ТЕСТ").UsedRange.Value ' Переносим в массив А, все значения из заполненной области листа с исходными данными
                     ' звание,тип,место службы,служба,должность,конец службы,причина увольнения
    ArStolbcy = Array(2, 3, 7, 8, 9, 11, 12)  ' Столбцы для проверки непустых значений
    Worksheets("ТЕСТ").Copy After:=Worksheets("ТЕСТ") ' Копируем лист - будем использовать для вывода результатов
    ActiveSheet.UsedRange.Offset(1, 0).Clear ' Очищаем старые данные ниже шапки
    Columns("A:A").NumberFormat = "@" 'Текстовый формат стлбца A
    Columns("J:K").NumberFormat = "DD.MM.YYYY" ' Форматирование столбцов J K - дата.
    Columns("M:M").NumberFormat = "@" 'Текстовый формат стлбца M
    k = 1 ' Нумерация строк на листе результатов, пропускаем заголовки
    For i = 2 To UBound(A) ' Перебираем массив А по строкам
        S = Trim(A(i, 4) & A(i, 5) & A(i, 6)) ' Соединяем строку Фамилия + Имя + Отчество
        If S <> "" Then
            ' Если ФИО не пустые, то появился новый человек номер k, работаем с ним, заносим в ячейку активного листа
            k = k + 1
            q = k ' Первая строка, в которой будет выводиться человек
            Cells(k, 1) = format(A(i, 1), "#.") ' порядковый номер
            Cells(k, 4) = A(i, 4) ' фамилию
            Cells(k, 5) = A(i, 5) ' имя
            Cells(k, 6) = A(i, 6) ' отчество
            Cells(k, 10) = A(i, 10) ' начало службы
        End If
        'Непустые данные из всех последующих строк текущего человека опять заносим в строку k
        If Trim(UCase(A(i, 2))) = "РЯДОВОЙ" Then
            ' Если элемент массива A(i, 2) содержит слово рядовой , то
            Cells(k, 1).Resize(1, 13).Interior.color = 16764057 ' красим фон диапазона в голубой цвет
        End If
        For j = 0 To 1 '  перебираем столбцы, номера которых в массиве ArStolbcy
            ' Если данные не пустые  , заносим их в первую строку по человеку q
            If Trim(A(i, ArStolbcy(j))) <> "" Then Cells(q, ArStolbcy(j)) = A(i, ArStolbcy(j))
        Next j
        If Trim(Cells(k, 12)) <> "" And Trim(A(i, 4)) = "" And Trim(A(i, 7)) <> "" Then
            ' Если ранее "причина увольнения" была заполнена и нет новой фамилии и есть не пустое место службы, то для человека добавляем еще 1 строку
            k = k + 1
            Cells(k, 1) = Cells(k - 1, 1) ' порядковый номер
        End If
        For j = 2 To UBound(ArStolbcy) '  перебираем столбцы, номера которых в массиве ArStolbcy
            ' Если данные не пустые  , заносим их
            If Trim(A(i, ArStolbcy(j))) <> "" Then Cells(k, ArStolbcy(j)) = A(i, ArStolbcy(j))
        Next j
        If IsEmpty(Cells(k, 10)) And A(i, 10) > 0 Then
            ' Если ранее "начало службы"  не было заполнена и не пуcтые текущие данные, то
            Cells(k, 10) = A(i, 10) ' начало службы
        End If
    Next i
    For k = 2 To k
        'Считаем текущий срок службы по строке k в формате "ГГ-ММ-ДД"
        If Cells(k, 10) > 0 And Cells(k, 11) > 0 Then 'Если обе даты заполнены
            SrokY = DateDiff("yyyy", Cells(k, 10), Cells(k, 11)) 'Находим разницу дат целое число лет
            Date2 = DateAdd("yyyy", SrokY, Cells(k, 10)) 'Прибавляем к дате из 10-того столбца целое число лет
            SrokM = DateDiff("m", Date2, Cells(k, 11)) 'Находим разницу дат целое число месяцев
            If SrokM < 0 Then ' Если отрицательное число месяцев
                Date2 = DateAdd("yyyy", -1, Date2) 'уменьшаем  Date2  на 1 год
                SrokY = SrokY - 1 ' Уменьшаем число лет на 1
                SrokM = DateDiff("m", Date2, Cells(k, 11)) ' Заново считаем число месяцев
            End If
            Date2 = DateAdd("m", SrokM, Date2) 'Прибавляем к дате Date2  целое число месяцев
            SrokD = Cells(k, 11) - Date2
            If SrokD < 0 Then ' Если отрицательное число дней
                Date2 = DateAdd("m", -1, Date2) 'уменьшаем  Date2  на 1 месяц
                SrokM = SrokM - 1 ' Уменьшаем число месяцев на 1
                SrokD = Cells(k, 11) - Date2 ' Заново считаем число дней
            End If
            Cells(k, 13) = format(SrokY, "00-") & format(SrokM, "00-") & format(SrokD, "00") ' Вносим выслугу в формате YY-MM-DD ( "ГГ-ММ-ДД")
        End If
   Next k
End Sub