VBA实现员工考勤表PTO自动更新：单元格更新异常求助

我正在开发一个VBA项目，用于自动更新员工考勤表中的带薪休假（PTO）信息。已知PTO数据仅包含开始日期和使用时长，无具体日期范围。核心逻辑如下：

• 根据PTO开始日期定位到对应月份的工作表
• 若PTO时长≤8小时，仅更新开始日期对应的单元格
• 若时长＞8小时，则依次向右填充单元格，直到剩余时长≤8小时

当前代码存在两处关键问题：

1. IsExcludedColumn函数无法正确排除代表周末的列（员工仅周一至周五工作）
2. 当PTO时长更新到月末仍有剩余时，无法自动将剩余时长结转至下月考勤表

相关截图说明 #

考勤表示意图：分月份的考勤表，顶部行是日期列，左侧是PTO类型行，用于记录每日休假时长
PTO列表示意图：存储PTO数据的表格，包含PTO类型、开始日期、使用时长等字段

现有代码 #

主更新过程代码

Sub UpdateTimesheets()
' Set the folder path to the directory containing the Excel files
Const folderPath As String = "C:\Users\smmy\Downloads\Test Copies 2\"

' Disable screen updating to improve performance
Application.ScreenUpdating = False

' Get the file name of the first Excel file in the folder
Dim fileName As String
fileName = Dir(folderPath & "*.xlsx")

' Loop through all Excel files in the folder
Do While fileName <> ""
    ' Check if the file is not a temporary file
    If Left(fileName, 7) <> "~$temp." Then
        ' Open the Excel file
        Dim timesheetWorkbook As Workbook
        Set timesheetWorkbook = Workbooks.Open(folderPath & fileName)

        ' Loop through the month tabs in the workbook
        Dim timesheetSheet As Worksheet
        For Each timesheetSheet In timesheetWorkbook.Sheets
            Select Case timesheetSheet.Name
                Case "January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December"
                    ' Find the corresponding PTO worksheet
                    Dim ptoSheet As Worksheet
                    Set ptoSheet = timesheetWorkbook.Sheets("FY12 PTO")

                    ' Loop through the PTO data in the PTO worksheet
                    Dim ptoRow As Long
                    For ptoRow = 2 To ptoSheet.Cells(Rows.Count, 1).End(xlUp).Row
                        ' Get the PTO type, start date, and hours from the PTO worksheet
                        Dim ptoType As String
                        Dim ptoStartDate As Date
                        Dim ptoHours As Double
                        ptoType = ptoSheet.Cells(ptoRow, 2).Value
                        ptoStartDate = DateValue(ptoSheet.Cells(ptoRow, 5).Value)
                        ptoHours = ptoSheet.Cells(ptoRow, 7).Value

                        ' Find the month tab corresponding to the PTO start date
                        Dim monthTab As Worksheet
                        Set monthTab = timesheetWorkbook.Sheets(Format(ptoStartDate, "mmmm"))

                        If Not monthTab Is Nothing Then
                            ' Find the corresponding date column in the month tab
                            Dim dateColumn As Range
                            Set dateColumn = monthTab.Range("C10:AK10").Find(What:=Day(ptoStartDate), LookIn:=xlValues, LookAt:=xlWhole)

                            If Not dateColumn Is Nothing Then
                                ' Find the row for the PTO type in the month tab
                                Dim ptoTypeRow As Range
                                Set ptoTypeRow = monthTab.Range("A13:A17").Find(What:=ptoType, LookIn:=xlValues, LookAt:=xlWhole)

                                If Not ptoTypeRow Is Nothing Then
                                    ' Get the cell in the timesheet for updating hours
                                    Dim currentCell As Range
                                    Set currentCell = monthTab.Cells(ptoTypeRow.Row, dateColumn.Column)

                                    ' Skip if the cell is in one of the excluded columns or has a holiday value
                                    If Not IsExcludedColumn(currentCell) And monthTab.Cells(15, currentCell.Column).Value <> "Holiday" Then
                                        ' Add hours to the timesheet cells
                                        Do While ptoHours > 0
                                            Dim remainingHours As Double
                                            remainingHours = WorksheetFunction.Max(8 - currentCell.Value, 0)

                                            If remainingHours > 0 Then
                                                If ptoHours >= remainingHours Then
                                                    currentCell.Value = currentCell.Value + remainingHours
                                                    ptoHours = ptoHours - remainingHours
                                                Else
                                                    currentCell.Value = currentCell.Value + ptoHours
                                                    ptoHours = 0
                                                End If
                                            End If

                                            If currentCell.Column = Columns("AL").Column Then
                                                Exit Do  ' Exit loop if column AL is reached
                                            End If

                                            Set currentCell = currentCell.Offset(0, 1)
                                        Loop
                                    End If
                                Else
                                    MsgBox "Row not found for PTO type '" & ptoType & "' in sheet '" & monthTab.Name & "'", vbExclamation
                                End If
                            Else
                                MsgBox "Column not found for date " & Format(ptoStartDate, "d") & " in sheet '" & monthTab.Name & "'", vbExclamation
                            End If
                        Else
                            MsgBox "Month tab not found for date " & Format(ptoStartDate, "mmmm"), vbExclamation
                        End If
                    Next ptoRow
            End Select
        Next timesheetSheet

        ' Save and close the Excel file
        timesheetWorkbook.Close SaveChanges:=True
    End If

    ' Get the file name of the next Excel file in the folder
    fileName = Dir
Loop

' Enable screen updating
Application.ScreenUpdating = True

MsgBox "Timesheets have been updated.", vbInformation
End Sub

排除列判断函数代码

Function IsExcludedColumn(cell As Range) As Boolean
Dim excludedColumns As Variant
excludedColumns = Array("C", "D", "J", "K", "Q", "R", "X", "Y", "AE", "AF", "AL")

Dim columnLetter As String
columnLetter = Split(cell.Address, "$")(1)

If columnLetter > "AL" Then
    IsExcludedColumn = True
Else
    Dim i As Long
    For i = LBound(excludedColumns) To UBound(excludedColumns)
        If columnLetter = excludedColumns(i) Then
            IsExcludedColumn = True
            Exit Function
        End If
    Next i
End If

IsExcludedColumn = False
End Function

内容的提问来源于stack exchange，提问作者Lenny