Автор Тема: Обновление данных в текущей книге взяв данные из второй книги при условии совпадения ФИО и должности  (Прочитано 506 раз)

Оффлайн Посетитель 26.10.2022

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

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

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

Макрос находится внутри первого файла. Экспериментировал по разному но пока безуспешно.. Может вы поможете или скажите хотя бы что поменять..

Оффлайн Администратор

  • Administrator
  • Сообщений: 2162
По этой теме вам не помогут на этом форуме.
На этом форуме отвечаю только я, я сейчас занят другими делами и не смогу посмотреть задание, т.к. надо его изучать.

Оффлайн Посетитель 26.10.2022

  • Посетитель форума
  • Сообщений: 3

Оффлайн Посетитель 26.10.2022

  • Посетитель форума
  • Сообщений: 3
Sub DDDR() 
  •    
  •     Dim shV As Worksheet, shITR As Worksheet, rng As Range, nil As Range 
  •     Dim ActualDate As Date, Nudost As String, Nudust As String, r0 As Long, r1 As Long, i As Long 
  •     Dim oXL As Workbook 
  •     Dim FileToOpen As String, sStr As Worksheet 
  •      
  •     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) 
  • Set sStr = oXL.Sheets("01-Журнал"
  •    
  •    
  •    
  •     ActualDate = sStr.Range("B4"
  •     r0 = 4 
  •     r1 = 42 
  •    
  •     For i = r0 To r1 
  •         If ActiveSheet.Cells(i, "D") <> "" Or ActiveSheet.Cells(i, "E") <> "" Then 
  •             Nudost = ActiveSheet.Cells(i, "D"
  •             Nudust = ActiveSheet.Cells(i, "E"
  •             Set rng = shV.Columns(2).Find(What:=Nudost, LookAt:=xlWhole) 
  •             Set nil = shV.Columns(3).Find(What:=Nudust, LookAt:=xlWhole) 
  •             If Not rng Is Nothing And Not nil Is Nothing Then 
  •                 rng.Offset(1, 4) = DateAdd("yyyy", 1, ActualDate) 
  •             Else 
  •                 Set rng = shITR.Columns(2).Find(What:=Nudost, LookAt:=xlWhole) 
  •                 Set nil = shITR.Columns(3).Find(What:=Nudust, LookAt:=xlWhole) 
  •                 If Not rng Is Nothing And Not nil Is Nothing Then rng.Offset(1, 4) = DateAdd("yyyy", 1, ActualDate) 
  •             End If 
  •         End If 
  •     Next
  • End Sub 
  • [/font][/size]