Question

我正在尝试构建一个Excel工作簿，以自动化并帮助创建每周工作计划。

我当前的工作簿可以正常运行，但是速度很慢-特别是在一项任务中，我有一份具有年度计划的人员列表，我同时搜索两张工作表。

我认为有一种比我正在使用的方法更好，更有效的方法 。

Option Explicit

'Global variable that will be in another module where I store all general config

Public Const PlanningAgentEmptyRange        As String = "C12:G58,F74:G78" 'Range agent present
Public Const PosteWeekDayRange               As String = "B12:B72" 'Range agent present
Public Const PosteWeekEndRange               As String = "B73:B78" 'Range agent present


Sub DraftFromCycle()

    'If range is empty (to prevent the lost of approved schedule)
    If Application.WorksheetFunction.CountA(Range(PlanningAgentEmptyRange)) = 0 Then

        'list of day/col Weekday in weekly schedule
        Dim aWeekDay(1 To 5) As String
        aWeekDay(1) = "C": aWeekDay(2) = "D": aWeekDay(3) = "E": aWeekDay(4) = "F": aWeekDay(5) = "G"

        'List of day/col weekEnd in weekly schedule
        Dim aWeekEnd(1 To 2) As String
        aWeekEnd(1) = "F": aWeekEnd(2) = "G"

        Dim DayDate As Range
        Dim cel As Range
        Dim Col As Variant
        Dim DayRangeCycle As Range
        Dim DayCycleCol As String
        Dim DayCycleRow As Integer
        Dim AgentName
        Dim p, s, poste, x As Variant
        Dim Cycle_lastrow As Integer
        Dim Cycle_lastcol As String


        Cycle_lastrow = LastRow(Feuil55)
        Cycle_lastcol = lastCol(Feuil55)


        'Loop col/Day  of weekday
        For Each Col In aWeekDay

            Set DayDate = Range(Col & "11")
            Set s = Worksheets("Cycle").Range("A5:OA5").Find(What:=DayDate, Lookat:=xlWhole)
            If Not s Is Nothing Then
                DayCycleCol = ColLetter(s.Column)

                For Each poste In Worksheets("Cycle").Range(DayCycleCol & "6:" & DayCycleCol & Cycle_lastrow)

                    Select Case poste
                    Case Is = "AM"
                        Set x = ActiveSheet.Range(PosteWeekDayRange).Find(What:="Après-midi", Lookat:=xlWhole)
                        If Not x Is Nothing Then
                            Do
                                If ActiveSheet.Range(Col & x.row) = "" Then
                                    ActiveSheet.Range(Col & x.row) = Worksheets("Cycle").Range("A" & poste.row).value
                                    ActiveSheet.Range(Col & x.row).Font.Italic = True
                                End If
                                Set x = ActiveSheet.Range(PosteWeekDayRange).FindNext(x)
                            Loop While Not x Is Nothing
                        End If

                    Case Is = "N"
                        Set x = ActiveSheet.Range(PosteWeekDayRange).Find(What:="Nuit", Lookat:=xlWhole)
                        If Not x Is Nothing Then
                            Do
                                If ActiveSheet.Range(Col & x.row) = "" Then
                                    ActiveSheet.Range(Col & x.row) = Worksheets("Cycle").Range("A" & poste.row).value
                                    ActiveSheet.Range(Col & x.row).Font.Italic = True
                                End If
                                Set x = ActiveSheet.Range(PosteWeekDayRange).FindNext(x)
                            Loop While Not x Is Nothing
                        End If

                    Case Is = "R N"
                        Set x = ActiveSheet.Range(PosteWeekDayRange).Find(What:="Récup Nuit", Lookat:=xlWhole)
                        If Not x Is Nothing Then
                            Do
                                If ActiveSheet.Range(Col & x.row) = "" Then
                                    ActiveSheet.Range(Col & x.row) = Worksheets("Cycle").Range("A" & poste.row).value
                                    ActiveSheet.Range(Col & x.row).Font.Italic = True
                                End If
                                Set x = ActiveSheet.Range(PosteWeekDayRange).FindNext(x)
                            Loop While Not x Is Nothing
                        End If

                    Case Is = "R Av"
                        Set x = ActiveSheet.Range(PosteWeekDayRange).Find(What:="R.H. Avant Garde", Lookat:=xlWhole)
                        If Not x Is Nothing Then
                            Do
                                If ActiveSheet.Range(Col & x.row) = "" Then
                                    ActiveSheet.Range(Col & x.row) = Worksheets("Cycle").Range("A" & poste.row).value
                                    ActiveSheet.Range(Col & x.row).Font.Italic = True
                                End If
                                Set x = ActiveSheet.Range(PosteWeekDayRange).FindNext(x)
                            Loop While Not x Is Nothing
                        End If

                    Case Is = "R Ap"
                        Set x = ActiveSheet.Range(PosteWeekDayRange).Find(What:="R.H. Après Garde", Lookat:=xlWhole)
                        If Not x Is Nothing Then
                            Do
                                If ActiveSheet.Range(Col & x.row) = "" Then
                                    ActiveSheet.Range(Col & x.row) = Worksheets("Cycle").Range("A" & poste.row).value
                                    ActiveSheet.Range(Col & x.row).Font.Italic = True
                                End If
                                Set x = ActiveSheet.Range(PosteWeekDayRange).FindNext(x)
                            Loop While Not x Is Nothing
                        End If

                    Case Is = "RTP"
                        Set x = ActiveSheet.Range(PosteWeekDayRange).Find(What:="R.T.P.", Lookat:=xlWhole)
                        If Not x Is Nothing Then
                            Do
                                If ActiveSheet.Range(Col & x.row) = "" Then
                                    ActiveSheet.Range(Col & x.row) = Worksheets("Cycle").Range("A" & poste.row).value
                                    ActiveSheet.Range(Col & x.row).Font.Italic = True
                                End If
                                Set x = ActiveSheet.Range(PosteWeekDayRange).FindNext(x)
                            Loop While Not x Is Nothing
                        End If

                    Case Else
                    End Select

                Next poste
            End If
        Next Col

        'Loop col du Week End
        For Each Col In aWeekEnd

            Set DayDate = Range(Col & "73")
            Set s = Worksheets("Cycle").Range("A5:OA5").Find(What:=DayDate, Lookat:=xlWhole)
            If Not s Is Nothing Then
                DayCycleCol = ColLetter(s.Column)

                For Each poste In Worksheets("Cycle").Range(DayCycleCol & "6:" & DayCycleCol & Cycle_lastrow)

                    Select Case poste
                    Case Is = "AM"
                        Set x = ActiveSheet.Range(PosteWeekEndRange).Find(What:="Après-midi", Lookat:=xlWhole)
                        If Not x Is Nothing Then
                            Do
                                If ActiveSheet.Range(Col & x.row) = "" Then
                                    ActiveSheet.Range(Col & x.row) = Worksheets("Cycle").Range("A" & poste.row).value
                                    ActiveSheet.Range(Col & x.row).Font.Italic = True
                                End If
                                Set x = ActiveSheet.Range(PosteWeekEndRange).FindNext(x)
                            Loop While Not x Is Nothing
                        End If

                    Case Is = "N"
                        Set x = ActiveSheet.Range(PosteWeekEndRange).Find(What:="Nuit", Lookat:=xlWhole)
                        If Not x Is Nothing Then
                            Do
                                If ActiveSheet.Range(Col & x.row) = "" Then
                                    ActiveSheet.Range(Col & x.row) = Worksheets("Cycle").Range("A" & poste.row).value
                                    ActiveSheet.Range(Col & x.row).Font.Italic = True
                                End If
                                Set x = ActiveSheet.Range(PosteWeekEndRange).FindNext(x)
                            Loop While Not x Is Nothing
                        End If

                    Case Is = "6h25"
                        Set x = ActiveSheet.Range(PosteWeekEndRange).Find(What:="6h25 - 13h25", Lookat:=xlWhole)
                        If Not x Is Nothing Then
                            Do
                                If ActiveSheet.Range(Col & x.row) = "" Then
                                    ActiveSheet.Range(Col & x.row) = Worksheets("Cycle").Range("A" & poste.row).value
                                    ActiveSheet.Range(Col & x.row).Font.Italic = True
                                End If
                                Set x = ActiveSheet.Range(PosteWeekEndRange).FindNext(x)
                            Loop While Not x Is Nothing
                        End If

                    Case Is = "7h30"
                        Set x = ActiveSheet.Range(PosteWeekEndRange).Find(What:="7h30 - 14h30", Lookat:=xlWhole)
                        If Not x Is Nothing Then
                            Do
                                If ActiveSheet.Range(Col & x.row) = "" Then
                                    ActiveSheet.Range(Col & x.row) = Worksheets("Cycle").Range("A" & poste.row).value
                                    ActiveSheet.Range(Col & x.row).Font.Italic = True
                                End If
                                Set x = ActiveSheet.Range(PosteWeekEndRange).FindNext(x)
                            Loop While Not x Is Nothing
                        End If

                    Case Is = "7h45"
                        Set x = ActiveSheet.Range(PosteWeekEndRange).Find(What:="7h45 - 14h45", Lookat:=xlWhole)
                        If Not x Is Nothing Then
                            Do
                                If ActiveSheet.Range(Col & x.row) = "" Then
                                    ActiveSheet.Range(Col & x.row) = Worksheets("Cycle").Range("A" & poste.row).value
                                    ActiveSheet.Range(Col & x.row).Font.Italic = True
                                End If
                                Set x = ActiveSheet.Range(PosteWeekEndRange).FindNext(x)
                            Loop While Not x Is Nothing
                        End If

                    Case Else
                    End Select

                Next poste
            End If
        Next Col

    End If
End Sub

这是一张床单的屏幕该模块从年度计划中获取数据，如果为空，则自动填写每周计划

年度时间表（工作表（“周期”））

每周计划（工作表（“ 1”））

如何提高VBA代码的速度和效率

0 个答案: