制作shcedule用的两个VBA小程序

最新推荐文章于 2024-11-24 15:30:55 发布

原创最新推荐文章于 2024-11-24 15:30:55 发布 · 184 阅读

0 ·

CC 4.0 BY-SA版权

备忘专栏收录该内容

11 篇文章

订阅专栏

本文介绍了一个使用VBA编写的Excel宏，该宏能够自动计算工作日，并排除指定的假期日期。通过运行此宏，用户可以快速计算两个日期之间的有效工作日数量，适用于项目计划和调度场景。

Sub ScheduleNext()
'
' ScheduleNext Macro
' マクロ記録日 : 2012/1/10  ユーザー名 : 川越事業所
'
' Keyboard Shortcut: Ctrl+n
'
'    With Selection.Interior
'        .ColorIndex = 8
'        .Pattern = xlSolid
'        .PatternColorIndex = xlAutomatic
'    End With
'    Range("F13").Select
'    ActiveCell.FormulaR1C1 = "6/6/2001"
 

    
    Dim holidays(6) As Date
    holidays(0) = "2012/1/2"
    holidays(1) = "2012/1/23"
    holidays(2) = "2012/1/24"
    holidays(3) = "2012/1/25"
    holidays(4) = "2012/4/4"
    holidays(5) = "2012/5/1"
    holidays(6) = "2012/6/22"
   
    If IsDate(ActiveCell.Value) Then
        Selection.NumberFormatLocal = "yyyy/m/d"
        ActiveCell.FormulaR1C1 = Application.Run("ATPVBAEN.XLA!WorkDay", ActiveCell.Value, 1, holidays)
    
    ElseIf IsEmpty(ActiveCell.Value) Then
        
        Selection.NumberFormatLocal = "yyyy/m/d"
                     
        Dim upleftRow As Integer
        upleftRow = ActiveCell.Row - 1
        
        Dim upColumn As Integer
        upleftColumn = ActiveCell.Column + 1
        
        Dim leftupRange As Range
        
        Set leftupRange = Cells(upleftRow, upleftColumn).MergeArea
        
        upleftRow = leftupRange.Row
        
        upleftColumn = leftupRange.Column
                    
        If IsDate(Cells(upleftRow, upleftColumn).Value) Then
         
            ActiveCell.FormulaR1C1 = Application.Run("ATPVBAEN.XLA!WorkDay", Cells(upleftRow, upleftColumn), 1, holidays)
        
        Else
        
        MsgBox "upleftの内容は日付ではない"
        
        End If
        
    Else
    
        MsgBox "該当cell1の内容をチェック"
    
    End If
       
 End Sub

Sub ScheduleCalender()
'
' Macro3 Macro
' マクロ記録日 : 2012/1/10  ユーザー名 : 川越事業所
'
' Keyboard Shortcut: Ctrl+m
'

    Dim holidays(6) As Date
    holidays(0) = "2012/1/2"
    holidays(1) = "2012/1/23"
    holidays(2) = "2012/1/24"
    holidays(3) = "2012/1/25"
    holidays(4) = "2012/4/4"
    holidays(5) = "2012/5/1"
    holidays(6) = "2012/6/22"
    
    Selection.NumberFormatLocal = "yyyy/m/d"
    
    Dim leftRow As Integer
    leftRow = ActiveCell.Row
        
    Dim leftColumn As Integer
    
    leftColumn = ActiveCell.Column - 1
    
  
    Dim rightRow As Integer
    rightRow = ActiveCell.Row
        
    Dim rightColumn As Integer
    rightColumn = ActiveCell.Column + 1
    
    If IsDate(Cells(leftRow, leftColumn).Value) Then
    
        If IsNumeric(Cells(rightRow, rightColumn).Value) And Not IsEmpty(Cells(rightRow, rightColumn).Value) Then
                
        ActiveCell.FormulaR1C1 = Application.Run("ATPVBAEN.XLA!WorkDay", Cells(leftRow, leftColumn).Value, Cells(rightRow, rightColumn).Value - 1, holidays)
        
        Else
            
            MsgBox "left right の内容は数値ではない"
                
        End If
                
    Else
    
    MsgBox "left cell の内容は日付ではない"
    
    End If
    

End Sub