Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Обновление уникальных значений с другого листа - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Обновление уникальных значений с другого листа (Макросы/Sub)
Обновление уникальных значений с другого листа
vadifed Дата: Понедельник, 02.08.2021, 10:20 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 2
Репутация: 0 ±
Замечаний: 0% ±

Добрый день!

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

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

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

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

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

Заранее спасибо!
К сообщению приложен файл: 0977424.xlsx(15.0 Kb)
 
Ответить
СообщениеДобрый день!

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

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

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

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

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

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

Автор - vadifed
Дата добавления - 02.08.2021 в 10:20
Erjoma1981 Дата: Понедельник, 02.08.2021, 14:50 | Сообщение № 2
Группа: Проверенные
Ранг: Новичок
Сообщений: 32
Репутация: 16 ±
Замечаний: 0% ±

[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]
К сообщению приложен файл: 0977424_1.xlsm(23.4 Kb)
 
Ответить
Сообщение[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]

Автор - Erjoma1981
Дата добавления - 02.08.2021 в 14:50
vadifed Дата: Понедельник, 02.08.2021, 15:47 | Сообщение № 3
Группа: Пользователи
Ранг: Прохожий
Сообщений: 2
Репутация: 0 ±
Замечаний: 0% ±

Erjoma1981, большое спасибо!!!
 
Ответить
СообщениеErjoma1981, большое спасибо!!!

Автор - vadifed
Дата добавления - 02.08.2021 в 15:47
Erjoma1981 Дата: Понедельник, 02.08.2021, 16:26 | Сообщение № 4
Группа: Проверенные
Ранг: Новичок
Сообщений: 32
Репутация: 16 ±
Замечаний: 0% ±

vadifed, пожалуйста.

Циклы лучше переставить. Т.к. не очень хорошо сначало добавлять элементы, а потом их проверять на уникальность.
 
Ответить
Сообщениеvadifed, пожалуйста.

Циклы лучше переставить. Т.к. не очень хорошо сначало добавлять элементы, а потом их проверять на уникальность.

Автор - Erjoma1981
Дата добавления - 02.08.2021 в 16:26
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Обновление уникальных значений с другого листа (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования Jobsora jooble
© 2010-2021 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!