Выборка в 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
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д