Ввод определенного статуса сотруднику по нескольким условиям VBA - Excel

Узнай цену своей работы

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

Есть например исходная таблица в которую вводятся данные о сотрудниках. Есть Имя и Фамилия сотрудника, есть также множество других данных (например: дата начала действия визы, дата конца визы) и т.п. Есть вторая таблица "Статус" назовем ее так. В эту таблицу вносятся Фамилия, Имя сотрудника и его статус. Статус определяется по условиям исходя из разных событий. Например статус "Имеет визу" и статус "Не имеет визу". Что нужно: - что бы была проверка по нескольким параметрам определенного сотрудника и исходя от результатов добавление в таблицу "Статус" данные о сотруднике включая его статус отталкиваясь от полученных данных после проверки. Пример: Сотрудник Иван Иванов, дата начала визы 01.01.2018, дата конца визы 01.06.2018. Необходимо что бы макрос нашел информацию по этому сотруднику которая была добавлена последней в таблицу "Исход" и проверил (если сегодняшняя дата больше даты начала визы и меньше даты конца) записал в таблицу "Статус" - "Имеет визу". В чем может быть сложность и подвох. Данные по сотрудниках в таблицу исход могут вносится частично. Например: строка 10 внесены какие то данные но столбцы с визой "пустые", информация о визе есть в строке 15 и строке 20. Можно ли заставить макрос что бы он нашел по этому сотруднику последнюю добавленную информацию и сравнил эти даты?. Есть примерный алгоритм как это сделать (за алгоритм спасибо Step_UA): 1. Считываем из таблицы статус в массивы имя и фамилия, и в отдельный массив статус (его в последующем используем для перезаписи данных на листе) 2. Формируем словарь, в цикле для каждой записи (строки) массивов добавляем в словарь элемент с ключем фамилия+имя и значением, равным номеру строки в массивах. Для словаря разумно установить сравнение как текст. 3. Считываем в масив(ы) данные из исходной таблицы: фамилия, имя, начало и окончание визы. 4. В цикле для каждой строки массива из п.3: **Если строка содержит дату начала/окончания и в словаре есть элемент с ключем фамилия+имя ****то присваиваем элементу массива статус с индексом из значения соответствующего элемента словаря, значение "имеет\не имеет" в соответствии с текущей датой 5. Выгружаем массив (перезаписываем данные) в столбец со статусом Но у меня не хватает знаний записать этот алгоритм кодом... Прошу помощи знатоков. Для Вас думаю это не так уж и сложно).. Заранее благодарю.

Решение задачи: «Ввод определенного статуса сотруднику по нескольким условиям VBA - Excel»

textual
Листинг программы
Sub kl()
  Dim Dic As Object, iRow&, aData, bVisa, eVisa, curDate As Date, sTmp$
    With Sheets("исход").ListObjects(1) ' первая таблица на листе "исход"
        aData = .ListColumns("Фамилия").Range.Value     ' фио
        bVisa = .ListColumns("Начало визы").Range.Value ' начало визы
        eVisa = .ListColumns("Конец визы").Range.Value  ' конец визы
    End With
    Set Dic = CreateObject("scripting.dictionary")      ' словарь
    curDate = Date      ' текущая дата
    For iRow = 2 To UBound(aData)   ' перебор данных
        If Not (IsEmpty(bVisa(iRow, 1)) Or IsEmpty(eVisa(iRow, 1))) Then
            ' присутствуют даты
            If (bVisa(iRow, 1) <= curDate) And (eVisa(iRow, 1) >= curDate) Then
                sTmp = "Имеет визу"
            Else
                sTmp = "Просрочена"
            End If
        Else
            sTmp = "Отсутствуют даты"   ' нет дат или одной из них
        End If
        Dic(aData(iRow, 1)) = sTmp      ' сохраняем для фио значение статуса
    Next
    Erase bVisa, eVisa  ' удаляем массивы
        
    With Sheets("статус").ListObjects(1)    ' первая таблица на листе "статус"
        aData = Intersect(.ListColumns("Фамилия").Range, .DataBodyRange).Value  ' фио - сюда же будем записывать статус
        For iRow = 1 To UBound(aData)
            If Dic.exists(aData(iRow, 1)) Then
                aData(iRow, 1) = Dic(aData(iRow, 1))    ' записываем статус из словаря для существующего фио
            Else
                aData(iRow, 1) = "Нет данных"   ' данных в словаре нет
            End If
        Next
        ' выгружаем массив в столбец статус
        Intersect(.ListColumns("Статус").Range, .DataBodyRange).Value = aData
    End With
End Sub

ИИ поможет Вам:


  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

14   голосов , оценка 4.143 из 5
Похожие ответы