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

Вход

Регистрация

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

 

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

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Обновление данных в текущей книге из другой закрытой
igorek72rus Дата: Воскресенье, 23.10.2022, 11:58 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 6
Репутация: 0 ±
Замечаний: 40% ±

Всем доброго дня, прошу помочь в решении проблемы.
Помогите пожалуйста создать макрос который будет обновлять данные в столбце F документа (матрица протокол) используя данные из другого документа (электронная форма по ОТ)
При условии если ФИО+должность совпадают с таким же фио+должность во втором документе, то из второго документа в первый будут переноситься значения "номер удостоверения" и значение "Даты"+1год в соответствующие ячейки первого документа.

Нюансы:
Может быть такое что ФИО у двух человек одинакова но должность разная.
Также хотел бы обратить внимание, что в первом документе два листа, и тот и другой лист сообщаются с общим вторым документом.
Может быть такое что Олегов Олег Олегович пройдет внеплановую проверку знаний и во втором документе он будет записан заново но уже с более свежей датой, как в этом случае макрос будет работать? Когда будут две одинаковые записи но у них буду отличаться лишь даты и номер удостоверения.

Прикрепил 2 пнг файла для наглядности что в итоге хотелось бы увидеть от итога макроса.
К сообщению приложен файл: ____VBA_test1.xlsx (303.8 Kb) · ___2_VBA_test_1.xlsx (264.4 Kb) · 7603401.png (16.4 Kb) · 4391260.png (44.4 Kb)
 
Ответить
СообщениеВсем доброго дня, прошу помочь в решении проблемы.
Помогите пожалуйста создать макрос который будет обновлять данные в столбце F документа (матрица протокол) используя данные из другого документа (электронная форма по ОТ)
При условии если ФИО+должность совпадают с таким же фио+должность во втором документе, то из второго документа в первый будут переноситься значения "номер удостоверения" и значение "Даты"+1год в соответствующие ячейки первого документа.

Нюансы:
Может быть такое что ФИО у двух человек одинакова но должность разная.
Также хотел бы обратить внимание, что в первом документе два листа, и тот и другой лист сообщаются с общим вторым документом.
Может быть такое что Олегов Олег Олегович пройдет внеплановую проверку знаний и во втором документе он будет записан заново но уже с более свежей датой, как в этом случае макрос будет работать? Когда будут две одинаковые записи но у них буду отличаться лишь даты и номер удостоверения.

Прикрепил 2 пнг файла для наглядности что в итоге хотелось бы увидеть от итога макроса.

Автор - igorek72rus
Дата добавления - 23.10.2022 в 11:58
igorek72rus Дата: Понедельник, 24.10.2022, 03:24 | Сообщение № 2
Группа: Пользователи
Ранг: Прохожий
Сообщений: 6
Репутация: 0 ±
Замечаний: 40% ±

[vba]
Код
Sub DDDR()

Dim shV As Worksheet, shITR As Worksheet, rng As Range
Dim ActualDate As Date, Nudost As String, r0 As Long, r1 As Long, i As Long
Dim oXL As Workbook
Dim FileToOpen As String, sStr As String

Set shV = ThisWorkbook.Sheets("Âàõòà+Ïîäìåííûå")
Set shITR = ThisWorkbook.Sheets("ÈÒÐ")

FileToOpen = "C:\Users\t506.hse\Desktop\Îçíàêîìëåíèå Èãîðÿ\TestVBA\Ýëåêòðîííàÿ ôîðìà ïî ÎÒ2 VBA test 1.xlsm"
Set oXL = Workbooks.Open(FileToOpen)
sStr = oXL.Sheets("01-Æóðíàë")

ActualDate = sStr.Range("B4")
r0 = 4
r1 = 42

For i = r0 To r1
If ActiveSheet.Cells(i, "D") <> "" Then
Nudost = ActiveSheet.Cells(i, "D")
Set rng = shV.Columns(2).Find(What:=Nudost, LookAt:=xlWhole)
If Not rng Is Nothing Then
rng.Offset(1, 4) = DateAdd("yyyy", 1, ActualDate)
Else
Set rng = shITR.Columns(2).Find(What:=Nudost, LookAt:=xlWhole)
If Not rng Is Nothing Then rng.Offset(1, 4) = DateAdd("yyyy", 1, ActualDate)
End If
End If
Next i
End Sub
[/vba]


Сообщение отредактировал Serge_007 - Понедельник, 24.10.2022, 08:32
 
Ответить
Сообщение[vba]
Код
Sub DDDR()

Dim shV As Worksheet, shITR As Worksheet, rng As Range
Dim ActualDate As Date, Nudost As String, r0 As Long, r1 As Long, i As Long
Dim oXL As Workbook
Dim FileToOpen As String, sStr As String

Set shV = ThisWorkbook.Sheets("Âàõòà+Ïîäìåííûå")
Set shITR = ThisWorkbook.Sheets("ÈÒÐ")

FileToOpen = "C:\Users\t506.hse\Desktop\Îçíàêîìëåíèå Èãîðÿ\TestVBA\Ýëåêòðîííàÿ ôîðìà ïî ÎÒ2 VBA test 1.xlsm"
Set oXL = Workbooks.Open(FileToOpen)
sStr = oXL.Sheets("01-Æóðíàë")

ActualDate = sStr.Range("B4")
r0 = 4
r1 = 42

For i = r0 To r1
If ActiveSheet.Cells(i, "D") <> "" Then
Nudost = ActiveSheet.Cells(i, "D")
Set rng = shV.Columns(2).Find(What:=Nudost, LookAt:=xlWhole)
If Not rng Is Nothing Then
rng.Offset(1, 4) = DateAdd("yyyy", 1, ActualDate)
Else
Set rng = shITR.Columns(2).Find(What:=Nudost, LookAt:=xlWhole)
If Not rng Is Nothing Then rng.Offset(1, 4) = DateAdd("yyyy", 1, ActualDate)
End If
End If
Next i
End Sub
[/vba]

Автор - igorek72rus
Дата добавления - 24.10.2022 в 03:24
  • Страница 1 из 1
  • 1
Поиск:

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