Question

我想根据条件使用VBA宏自动复制和粘贴单元格。

我尝试使用VLOOKUP和MATCH函数以及一些用于复制单元格的VBA代码，但我似乎无法实现我想要的。

我的目标是将Sheet1（LMSData）和Sheet2（Schedule）中的某些单元格复制到另一个工作表（学习名册），其中[LMSData！A2：A]中的唯一ID = [Schedule！B2：BA]中的人员ID < / p>

如果有一个或多个匹配项，我想将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

您可以使用以下脚本进行这项工作。

我已经考虑了LMS数据表中的列（能力名称，有效日期，人员ID）和计划表中的列（人员ID，开始日期，开始时间，完成时间）。

您可以根据需要修改数据类型

下面是执行的步骤：

从计划表中选择人员ID。
使用人员ID过滤LMSData工作表并将可见记录复制到临时工作表中。
将所有这些记录复制到“学习名册”表中。

'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

结束子

创建一个VBA Excel宏以根据主ID匹配将单元格复制到另一个工作表

1 个答案: