Question

我有一个工作簿，在（控制表）中有员工ID，有其ID和各种补偿信息的数据（数据表），还有一个显示带有薪资表的模板的表（绩效表）。

优点表具有一个表单模板，该模板根据索引/匹配公式（全部引用该表的单元格P1中的员工ID）填充一堆箱子。

我的同事正在使用这个容易出错的非常复杂的VBA脚本，我想知道是否有更简单的方法来做到这一点：

转到控制表，找到第一个员工ID（有标题行）
在优点表的单元格P1中填充该ID
将新填充的数据作为.pdf导出

原始代码：

Sub Statement_Autoprint()
'
' Macro1 Macro

Dim StartTime As Date
StartTime = Now()

Dim MCST As Workbook
Set MCST = ActiveWorkbook
Dim User As String
User = Environ$("Username")
Dim SavePath As String
Dim MgrPath As String
SavePath = "C:\Users\" & User & "\Desktop\Manual Comp Statements\"

If Dir(SavePath, vbDirectory) = vbNullString Then
    MkDir SavePath
End If

Dim LoopRow As Integer
Dim Printed As Integer
LoopRow = 2
Printed = 0

Dim Emplid As String
Dim EmpName As String
Dim MgrName As String
Dim Statement As String
Dim Range As Range
Dim rowstocheck As Range
'With MCST.Sheets(Statement)

'End With

On Error GoTo ErrorHandler:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic

Do While Trim(MCST.Sheets("Control Sheet").Range("B" & LoopRow)) <> ""

    If Trim(MCST.Sheets("Control Sheet").Range("A" & LoopRow)) <> "" Then
        Statement = MCST.Sheets("Control Sheet").Range("A" & LoopRow)
        Emplid = Format(MCST.Sheets("Control Sheet").Range("B" & LoopRow), "000000000")

        MCST.Sheets(Statement).Activate
        MCST.Sheets(Statement).Calculate
        MCST.Sheets(Statement).Range("P1") = Emplid
            Set rowstocheck = MCST.Sheets(Statement).Range("N2:N70")     
                For Each Cell In rowstocheck
                If Cell.Value = "HIDE" Then
                        Cell.EntireRow.Hidden = True
                ElseIf Cell.Value <> "HIDE" Then Cell.EntireRow.Hidden = False
                End If
                Next Cell                                              
        If Not Application.CalculationState = xlDone Then
            DoEvents
        End If

        EmpName = MCST.Sheets(Statement).Range("C5")
        MgrName = MCST.Sheets(Statement).Range("K5")

        MgrPath = "C:\Users\" & User & "\Desktop\Manual Comp Statements\" & MgrName & "\"
        If Dir(MgrPath, vbDirectory) = vbNullString Then
            MkDir MgrPath
        End If

        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
            Filename:=MgrPath & "2018 Mid-Year Comp Statement - " & EmpName & ".pdf", _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
            OpenAfterPublish:=False
        Printed = Printed + 1
    End If
    LoopRow = LoopRow + 1
Loop

Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.DisplayAlerts = True

Sheets("Control Sheet").Activate

MsgBox "Execution Complete;" & vbCrLf & _
        Round((Now() - StartTime) * 86400, 0) & " Second Run Time." & vbCrLf & _
        (LoopRow - 2) & " Considered" & vbCrLf & _
        Printed & " Statements Printed"

Exit Sub

ErrorHandler:
    Resume Next
End Sub

Sub Reactivate_Functions()
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

我只是觉得它不需要这么复杂，对于我想要实现的目标来说，这看起来是否过于复杂？我希望有一些简单的方法，这样我可以理解在代码中断的情况下应该解决的问题。

Answer 1

我开始了，但是今天没有时间完成。我试图将其浓缩，以便您可以跟随并希望自己看到痛苦的地方。

我将摆脱For Each MyCell循环，而仅根据您的条件HIDE进行过滤。循环和隐藏可能很耗时，因此过滤器会更快。

Option Explicit

Sub Statement_Autoprint()

Dim StartTime As Date: StartTime = Now()

Dim MCST As Workbook: Set MCST = ActiveWorkbook
Dim User As String: User = Environ$("Username")
Dim SavePath As String: SavePath = "C:\Users\" & User & "\Desktop\Manual Comp Statements\"
Dim CS As Worksheet: Set CS = MCST.Sheets("Control Sheet")

Dim MgrPath As String, MyCell As Range, Printed As Integer, i As Integer, SM As Worksheet
Printed = 0

If Dir(SavePath, vbDirectory) <> "" Then
    MkDir SavePath
End If

Call Disable

For i = 2 To CS.Range("B" & CS.Rows.Count).End(xlUp).Row
    If CS.Range("A" & i) <> "" & CS.Range("B" & i) <> "" Then
        Set SM = MCST.Sheets(CS.Range("A" & i))
        SM.Calculate
        SM.Range("P1") = Format(CS.Range("B" & i), "000000000")

            For Each MyCell In SM.Range("N2:N70")
                If MyCell = "HIDE" Then
                    MyCell.EntireRow.Hidden = True
                ElseIf MyCell <> "HIDE" Then
                    MyCell.EntireRow.Hidden = False
                End If
            Next MyCell

        If Not Application.CalculationState = xlDone Then
            DoEvents
        End If

        MgrPath = "C:\Users\" & User & "\Desktop\Manual Comp Statements\" & SM.Range("K5") & "\"

        If Dir(MgrPath, vbDirectory) <> "" Then
            MkDir MgrPath
        End If

        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
            Filename:=MgrPath & "2018 Mid-Year Comp Statement - " & SM.Range("C5") & ".pdf", _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
            OpenAfterPublish:=False

        Printed = Printed + 1
    End If
Next i

CS.Activate

Call Re_Enable

MsgBox "Execution Complete;" & vbCrLf & _
        Round((Now() - StartTime) * 86400, 0) & " Second Run Time." & vbCrLf & _
        (i - 2) & " Considered" & vbCrLf & _
        Printed & " Statements Printed"

End Sub

Sub Disable()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
End Sub

Sub Re_Enable()
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

循环浏览INDEX和MATCH模板的员工ID列表？

1 个答案: