Question

我有4个连续运行的潜艇。对于其他三个，第一个子组有Call个。我遇到了两个问题。

除了我去的时候，Copy_To_Template sub完成所有部分进入工作簿，数据被复制到WGM工作表是空的。数据已成功复制到其他工作表正确。
Filter_AGD sub根本没有删除行。我会注意到我不确定Filter_WGM子是否正常工作，因为工作表中没有数据。 Filter_SWGM 按预期工作。

以下是所有4组代码：

Sub Copy_To_Template()
'
    ' The following is a list of the Source Workbooks and Worksheets

    Dim PRM1 As Workbook ' source workbook 1 contains current list of unassigned Problem Tasks
        Set PRM1 = Workbooks("BCRS-PTASKS Unassigned.csv")
    Dim PRM2 As Workbook ' source WorkBook 2 contains all assignment group information
        Set PRM2 = Workbooks("Problem WGM & WGL xref with description.xls")
    Dim PTASKS_Unassigned As Worksheet ' source WorkSheet
        Set PTASKS_Unassigned = PRM1.Sheets("BCRS-PTASKS Unassigned")
    Dim MANs As Worksheet
        Set MANs = PRM2.Sheets("Page 1")

    ' The following is a list of all the Destination workbooks and worksheets

    Dim PTASK_Template As Workbook ' destination WorkBook
        Set PTASK_Template = Workbooks("BCRS Unassigned Tasks Template.xlsm")
    Dim PTASK As Worksheet
        Set PTASK = PTASK_Template.Sheets("BCRS Unassigned Tasks")
    Dim WGMd As Worksheet
        Set WGMd = PTASK_Template.Sheets("WGM")
    Dim SWGMd As Worksheet
        Set SWGMd = PTASK_Template.Sheets("SWGM")
    Dim AGDd As Worksheet
        Set AGDd = PTASK_Template.Sheets("AGD")

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    ' Copy Unassigned Tasks

    Dim LRUPT As Long
    LRUPT = PTASKS_Unassigned.Range("A" & Rows.Count).End(xlUp).Row
    Dim UPTRow As Long
    UPTRow = PTASK.Cells(Rows.Count, 1).End(xlUp).Row + 1 ' DestinationRow
    PTASKS_Unassigned.Range("A2:F" & LRUPT).Copy PTASK.Range("A" & UPTRow)

    PTASK.Range("A:A,B:B,C:C,D:D,E:E,F:F").Columns.AutoFit
    PTASK.Cells.WrapText = False

    ' Copy to WGM

    Dim LRWGM As Long
    LRWGM = MANs.Range("A" & MANs.Rows.Count).End(xlUp).Row
    Dim WGMRow As Long
    WGMRow = WGMd.Cells(Rows.Count, 1).End(xlUp).Row + 1 ' DestinationRow
    MANs.Range("A2:E" & LRWGM).Copy WGMd.Range("A" & WGMRow)

    WGMd.Range("A:A,B:B,C:C,D:D,E:E").Columns.AutoFit
    WGMd.Cells.WrapText = False

    ' Copy to SWGM

    Dim LRSWGM As Long
    LRSWGM = MANs.Range("A" & MANs.Rows.Count).End(xlUp).Row
    Dim SWGMRow As Long
    SWGMRow = SWGMd.Cells(Rows.Count, 1).End(xlUp).Row + 1 ' DestinationRow
    MANs.Range("A2:E" & LRSWGM).Copy SWGMd.Range("A" & SWGMRow)

    SWGMd.Range("A:A,B:B,C:C,D:D,E:E").Columns.AutoFit
    SWGMd.Cells.WrapText = False

    ' Copy to AGD

    Dim LRAGD As Long
    LRAGD = MANs.Range("A" & MANs.Rows.Count).End(xlUp).Row
    Dim AGDRow As Long
    AGDRow = AGDd.Cells(Rows.Count, 1).End(xlUp).Row + 1 ' DestinationRow
    MANs.Range("A2:E" & LRAGD).Copy AGDd.Range("A" & AGDRow)

    AGDd.Range("A:A,B:B,C:C,D:D,E:E").Columns.AutoFit
    AGDd.Cells.WrapText = False

    Dim WB1 As Workbook
        Set WB1 = Workbooks("BCRS-PTASKS Unassigned.csv")

    Dim WB2 As Workbook
        Set WB2 = Workbooks("Problem WGM & WGL xref with description.xls")

    WB1.Close False
    WB2.Close False

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

    Call Filter_WGM
    Call Filter_SWGM
    Call Filter_AGD

End Sub

Sub Filter_WGM()
'

    Dim PTASK_Template As Workbook
        Set PTASK_Template = Workbooks("BCRS Unassigned Tasks Template.xlsm")
    Dim WGMd As Worksheet
        Set WGMd = PTASK_Template.Sheets("WGM")

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual


        With WGMd
        Dim LRMf As Long
            For LRMf = .Cells(Rows.Count, 3).End(xlUp).Row To 2 Step -1
                If .Cells(LRMf, 3).Value <> "WorkGroup Manager" Then
                    .Rows(LRMf).Delete
                End If
            Next LRMf
        End With

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

End Sub

Sub Filter_SWGM()
'
    Dim PTASK_Template As Workbook
        Set PTASK_Template = Workbooks("BCRS Unassigned Tasks Template.xlsm")
    Dim SWGMd As Worksheet
        Set SWGMd = PTASK_Template.Sheets("SWGM")

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual


        With SWGMd
        Dim LRSf As Long
            For LRSf = .Cells(Rows.Count, 3).End(xlUp).Row To 2 Step -1
                If .Cells(LRSf, 3).Value <> "Secondary WorkGroup Manager" Then
                    .Rows(LRSf).Delete
                End If
            Next LRSf
        End With

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

End Sub

Sub Filter_AGD()
'        
    Dim PTASK_Template As Workbook
        Set PTASK_Template = Workbooks("BCRS Unassigned Tasks Template.xlsm")
    Dim AGDd As Worksheet
        Set AGDd = PTASK_Template.Sheets("WGM")

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual


        With AGDd
        Dim LRDf As Long
            For LRDf = .Cells(Rows.Count, 3).End(xlUp).Row To 2 Step -1
                If .Cells(LRDf, 3).Value <> "Director / DL" Then
                    .Rows(LRDf).Delete
                End If
            Next LRDf
        End With

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

End Sub

Answer 1

如果不是您上次评论中概述的调试，我不会发现这个。因此，对于让我们达到这一点的所有评论者来说都是不错的。

您的Filter_AGD子指向WGM工作表，并在那里清除数据......

Sub Filter_AGD()
'        
    Dim PTASK_Template As Workbook
        Set PTASK_Template = Workbooks("BCRS Unassigned Tasks Template.xlsm")
    Dim AGDd As Worksheet
        Set AGDd = PTASK_Template.Sheets("WGM")

应该......

Sub Filter_AGD()
'        
    Dim PTASK_Template As Workbook
        Set PTASK_Template = Workbooks("BCRS Unassigned Tasks Template.xlsm")
    Dim AGDd As Worksheet
        Set AGDd = PTASK_Template.Sheets("AGD")

代码无法正常工作

1 个答案: