Создание макроса VBA Excel для копирования ячеек на другой лист на основе соответствия первичного идентификатора

Question

Я хочу автоматически копировать и вставлять ячейки с помощью макроса VBA в зависимости от условий.

Я пытался использовать функции VLOOKUP и MATCH, а также некоторый код VBA, используемый для копирования ячеек, я простоКажется, я не могу достичь того, что мне нужно.

Моя цель - скопировать некоторые ячейки из Листа 1 (LMSData) и Листа 2 (Расписание) на другой лист (Список обучения), где уникальный идентификатор в [LMSData! A2: A] = идентификатор человека в [Расписание! B2: BA]

Если есть совпадение (или несколько совпадений), я хочу также скопировать имя компетенции и дату окончания срока действия из данных LMS в Sheet3 (LearningRoster).как PersonID, Дата начала, Время начала и Время окончания от расписания до Учебного реестра.

Изображения с листами, упомянутыми выше, можно найти здесь.

https://i.imgur.com/Y76Wezb.jpg - LMSData

https://i.imgur.com/iETSkVO.jpg - Расписание

https://imgur.com/Y76Wezb.jpg - LearningRoster

Я быочень признателен за любую помощь, или быть направленным в правильном направлении.

Спасибо

Answer 1

Вы можете использовать приведенный ниже скрипт для этой работы.

Я рассмотрел столбец (Имя компетенции, Дата истечения срока действия, Идентификатор лица) в Листе данных LMSData и столбец (Идентификатор лица, Дата начала, Время начала, Время окончания) для Листа расписания.

Вы можете изменить тип данных в зависимости от ваших требований

Ниже приведены выполненные действия:

1. Выбор идентификатора человека из расписания.

2. Фильтр листа LMSData с персоной и копирование видимой записи во временный лист.

3. Скопируйте всю эту запись в лист Учебного реестра.

'Sub copyData ()

Dim PersonId, StartDate, StartTime, FinishTime, CompentencyName, ExpiryDate, CompetencyName As String
Dim ScheduleIndex, TempIndex, LearningRosterIndex As Integer

ScheduleIndex = 2
LearningRosterIndex = 2

Do While ThisWorkbook.Sheets("Schedule").Cells(ScheduleIndex, 1).Value <> ""
    PersonId = ThisWorkbook.Sheets("Schedule").Cells(ScheduleIndex, 1).Value
    StartDate = ThisWorkbook.Sheets("Schedule").Cells(ScheduleIndex, 2).Value
    StartTime = ThisWorkbook.Sheets("Schedule").Cells(ScheduleIndex, 3).Value
    FinishTime = ThisWorkbook.Sheets("Schedule").Cells(ScheduleIndex, 4).Value
    With ThisWorkbook.Sheets("LMSData")
        .AutoFilterMode = False
        With .Range("A1:C100000")
            .AutoFilter Field:=3, Criteria1:=Array(PersonId), Operator:=xlFilterValues
            .SpecialCells(xlCellTypeVisible).Copy Destination:=ThisWorkbook.Sheets("Temp").Range("A1")
        End With
    End With
    TempIndex = 2
    Do While ThisWorkbook.Sheets("Temp").Cells(TempIndex, 1).Value <> ""
        CompetencyName = ThisWorkbook.Sheets("Temp").Cells(TempIndex, 1).Value
        ExpiryDate = ThisWorkbook.Sheets("Temp").Cells(TempIndex, 2).Value
        ThisWorkbook.Sheets("LearningRoster").Cells(LearningRosterIndex, 1).Value = PersonId
        ThisWorkbook.Sheets("LearningRoster").Cells(LearningRosterIndex, 2).Value = StartDate
        ThisWorkbook.Sheets("LearningRoster").Cells(LearningRosterIndex, 3).Value = StartTime
        ThisWorkbook.Sheets("LearningRoster").Cells(LearningRosterIndex, 4).Value = FinishTime
        ThisWorkbook.Sheets("LearningRoster").Cells(LearningRosterIndex, 5).Value = CompetencyName
        ThisWorkbook.Sheets("LearningRoster").Cells(LearningRosterIndex, 6).Value = ExpiryDate
        LearningRosterIndex = LearningRosterIndex + 1
        TempIndex = TempIndex + 1
    Loop

    ThisWorkbook.Sheets("Temp").Range("A1:C10000").ClearContents

    With ThisWorkbook.Sheets("LMSData")
        .AutoFilterMode = False
        With .Range("A1:C100000")
            .AutoFilter Field:=3, Criteria1:="*", Operator:=xlFilterValues
        End With
    End With
    ScheduleIndex = ScheduleIndex + 1
Loop

End Sub `