Excel это не сложно
Добро пожаловать, Гость. Пожалуйста, войдите или зарегистрируйтесь.
29.03.2024, 15:39:44

Войти
На форуме добавлена возможность подписки на RSS-ленты любого раздела форума. Подписаться можно, нажав на иконку RSS , расположенную левее наименования раздела.
33 233 Сообщений в 5 454 Тем от 6 753 Пользователей
Последний пользователь: malanik777
*
Перейти на сайт Хитрости Надстройка MulTEx Обучающие тренинги Наша группа ВКонтакте
Правила форума Начало Помощь Поиск Календарь Войти Регистрация Выйти
+  Excel это не сложно
|-+  Основные форумы
| |-+  Вопросы по Word и VBA
| | |-+  Обновление данных в текущей книге взяв данные из второй книги при условии
Страниц: [1]   Вниз
Печать
Автор Тема: Обновление данных в текущей книге взяв данные из второй книги при условии  (Прочитано 3922 раз)
0 Пользователей и 1 Гость смотрят эту тему.
igorek72rus
Новичок
*

Репутация: +0/-0
Офлайн Офлайн

Сообщений: 1


Просмотр профиля E-mail
« : 24.10.2022, 15:21:11 »

Код: (vb)
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 i
End Sub


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

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

Репутация: +485/-0
Офлайн Офлайн

Сообщений: 5 828



Просмотр профиля WWW
« Ответ #1 : 24.10.2022, 16:23:37 »

А к Word это какое отношение имеет? Вы тему создали в ветке "Вопросы по Word и VBA - Обсуждение вопросов, связанных с проблемами по Word и написанию кодов в VBA модели Word"
как в этом случае макрос будет работать?
ровно так, как его напишут.
Записан

Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
Пункты приёма Спасибов:    -41001332272872  -R298726502453
Страниц: [1]   Вверх
Печать
Перейти в:  

Powered by MySQL Powered by PHP Powered by SMF 1.1.21 | SMF © 2006-2011, Simple Machines Valid XHTML 1.0! Valid CSS!
Яндекс.Метрика Рейтинг@Mail.ru