Обновление уникальных значений с другого листа

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Обновление уникальных значений с другого листа (Макросы/Sub)

vadifed

Дата: Понедельник, 02.08.2021, 10:20 | Сообщение № 1

Группа: Пользователи

Ранг: Прохожий

Сообщений: 2

Репутация: 0 ±

Замечаний: 0% ±

Добрый день!

Прошу Вас о помощи в решении проблемы (макросом).

Вводная задача: есть таблица из 2 листов: "Для уникальных значений" и "Штатное расписание" (далее - ШР). Лист ШР обновляется каждую неделю вручную.

На лист "Для уникальных значений" необходимо:
- сравнивать Ф.И.О. на листах;
- выявлять уникальные значение Ф.И.О. и по этому,
- добавлять на лист "Для уникальных значений" (в столбец "Сотрудник") Ф.И.О. новых сотрудников;
- удалять с листа "Для уникальных значений" (в столбец "Сотрудник") Ф.И.О. уволенных сотрудников;

Видел несколько тем, с похожими решениями, но они не подходят.

Прошу Вас помочь с макросом...

Заранее спасибо!

К сообщению приложен файл: 0977424.xlsx (15.0 Kb)

Ответить

Erjoma1981

Дата: Понедельник, 02.08.2021, 14:50 | Сообщение № 2

Группа: Проверенные

Ранг: Участник

Сообщений: 66

Репутация: 25 ±

Замечаний: 0% ±

Excel 2010, 2019

[vba]

Код

Public Sub ИзменениеТаблиц()
    Dim НайденноеЗначение As Range
    Dim НомерСтроки As LongPtr
    Dim ВнесеныИзменения As Boolean

    Application.EnableEvents = False
    For НомерСтроки = 1 To Range("Таблица1").Rows.Count
        Set НайденноеЗначение = Range(Range("Таблица3").Cells(1, 2), Range("Таблица3").Cells(Range("Таблица3").Rows.Count, 2)) _
                    .Find(what:=Range("Таблица1").Cells(НомерСтроки, 2).Value, LookIn:=xlValues, LookAt:=xlWhole)
        If НайденноеЗначение Is Nothing Then
            Sheets("Для уникальных значений").ListObjects("Таблица3").ListRows.Add
            Range("Таблица3").Cells(Range("Таблица3").Rows.Count, 2).Value = Range("Таблица1").Cells(НомерСтроки, 2).Value
            If Not ВнесеныИзменения Then
                ВнесеныИзменения = True
            End If
        End If
    Next НомерСтроки

    НомерСтроки = 1
    Do While НомерСтроки <= Range("Таблица3").Rows.Count
        Set НайденноеЗначение = Range(Range("Таблица1").Cells(1, 2), Range("Таблица1").Cells(Range("Таблица1").Rows.Count, 2)) _
                    .Find(what:=Range("Таблица3").Cells(НомерСтроки, 2).Value, LookIn:=xlValues, LookAt:=xlWhole)
        If НайденноеЗначение Is Nothing Then
            Range("Таблица3").Rows(НомерСтроки).Delete
            If Not ВнесеныИзменения Then
                ВнесеныИзменения = True
            End If
        Else
            НомерСтроки = НомерСтроки + 1
        End If
    Loop

    If ВнесеныИзменения Then
        For НомерСтроки = 1 To Range("Таблица3").Rows.Count
            Range("Таблица3").Cells(НомерСтроки, 1).Value = НомерСтроки
        Next НомерСтроки
    End If
    Application.EnableEvents = True
End Sub

[/vba]

[vba]

Код