首页 > 解决方案 > 找到匹配项时,将行从一张表复制到宏中找到匹配项的行

问题描述

我在 MainDashboard 上有一个由宏更新的表。它从选定的工作表中复制数据并更新此主表。这是我的代码,但我被卡住了。我需要它:

遍历工作表列表中的每个工作表

循环遍历每张工作表上表的第一列中的每个值

检查这些 ID 是否在 Main Dashboard 表的第一列中

如果是,则复制该行上的所有内容并将其粘贴到在主仪表板表中找到该值的同一行

如果没有,将其添加到行的底部

完成后有一个 MsgBox 说,你已经修改了 x 个条目并添加了 x 个新条目

Sub Update()

    Dim SheetList As Variant
    Dim x As Long
    Dim TaskListTable As Range
    Dim TaskList As ListObject
    Dim SortColumn As Range
    Dim TaskId As Integer
    Dim LastRow As Range
    Dim MDLastRow As Range
    
    'What I want the Excel program to do before I start
    With Application
        .ScreenUpdating = False
        .StatusBar = "Running..."
    End With
    
    'List Sheet Names into an Array Variable
    SheetList = Array(S1, S2, S3, S4, S5, S6, S7, S8, S9, S10, S11, S12, S13, S14)
    
    'Loop through list
    For x = LBound(SheetList) To UBound(SheetList)
        'Code will fail unless you activate the sheet first
        SheetList(x).Activate
        
        'Loop for b15 in column 1 down for every row to last row
        LastRow = Range("B" & Rows.Count).End(xlUp).Row
        MDLastRow = Range("B" & Rows.Count).End(xlUp).Row
        
        For Each TaskID In Range("B15": LastRow)
            If WorksheetFunction.Match(Range("B15:MDLastRow"),  Then
            SheetList(x).Range("TaskID").End(xlRight).Copy
            
            'PASTE TO ENTIRE ROW WHERE THE MATCH WAS FOUND
            End If
            
            'Else add row to the bottom
            SheetList(x).Range("TaskID").End(xlRight).Copy
            MainDashboard.Range("B" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteAll
    Next x
    
    MainDashboard.Activate
    
    'MsgBox
    'You have Modified X tasks
    'You have Added X tasks
    
    'Sort the table by the latest Date
    Set TaskList = MainDashboard.ListObjects("Task_List")
    Set SortColumn = Range("Task_List[DATE]")
    With TaskList.Sort
       .SortFields.Clear
       .SortFields.Add Key:=SortColumn, SortOn:=xlSortOnValues, Order:=xlAscending
       .Header = xlYes
       .Apply
    End With
    
    'What I want the Excel program to do after I have finished
   With Application
        .ScreenUpdating = True
        .StatusBar = "Complete"
        .CutCopyMode = False
    End With
    
End Sub

提前致谢

标签: excelvba

解决方案


推荐阅读