c0f8d8163d
- Fix test result indicators encoding (use ?? instead of Unicode symbols) - Add missing newlines at end of files - Add new VBA module files for main functionality Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
131 lines
3.4 KiB
QBasic
131 lines
3.4 KiB
QBasic
Option Explicit
|
||
|
||
' 自定义工作日计算函数
|
||
' 用法: =WORKDAYS_CUSTOM(开始日期, 结束日期)
|
||
' 基于"2026年工作日历"表中的休息日数据计算工作日天数
|
||
Function WORKDAYS_CUSTOM(startDate As Date, endDate As Date) As Long
|
||
Dim ws As Worksheet
|
||
Dim currentDate As Date
|
||
Dim workdayCount As Long
|
||
Dim lastRow As Long
|
||
Dim i As Long
|
||
Dim dateInSheet As Date
|
||
Dim isRest As String
|
||
Dim found As Boolean
|
||
|
||
On Error GoTo ErrorHandler
|
||
|
||
' 确保开始日期小于等于结束日期
|
||
If startDate > endDate Then
|
||
WORKDAYS_CUSTOM = 0
|
||
Exit Function
|
||
End If
|
||
|
||
' 获取工作表
|
||
Set ws = ThisWorkbook.Sheets("日历")
|
||
|
||
' 找到最后一行
|
||
lastRow = ws.Cells(ws.Rows.count, "A").End(xlUp).Row
|
||
|
||
' 初始化计数器
|
||
workdayCount = 0
|
||
currentDate = startDate
|
||
|
||
' 遍历日期范围
|
||
Do While currentDate <= endDate
|
||
found = False
|
||
|
||
' 在表中查找当前日期
|
||
For i = 2 To lastRow ' 从第2行开始（第1行是表头）
|
||
dateInSheet = CDate(ws.Cells(i, 1).Value)
|
||
|
||
If dateInSheet = currentDate Then
|
||
isRest = ws.Cells(i, 2).Value
|
||
found = True
|
||
|
||
' 如果不是休息日，计数加1
|
||
If isRest = "否" Then
|
||
workdayCount = workdayCount + 1
|
||
End If
|
||
|
||
Exit For
|
||
End If
|
||
Next i
|
||
|
||
' 如果日期不在表中（例如其他年份），返回错误
|
||
If Not found And Year(currentDate) = 2026 Then
|
||
WORKDAYS_CUSTOM = CVErr(xlErrValue)
|
||
Exit Function
|
||
End If
|
||
|
||
' 移动到下一天
|
||
currentDate = DateAdd("d", 1, currentDate)
|
||
Loop
|
||
|
||
WORKDAYS_CUSTOM = workdayCount
|
||
Exit Function
|
||
|
||
ErrorHandler:
|
||
WORKDAYS_CUSTOM = CVErr(xlErrValue)
|
||
End Function
|
||
|
||
|
||
' 优化版本：使用字典提高查询速度
|
||
Function WORKDAYS_CUSTOM_FAST(startDate As Date, endDate As Date) As Long
|
||
Dim ws As Worksheet
|
||
Dim currentDate As Date
|
||
Dim workdayCount As Long
|
||
Dim lastRow As Long
|
||
Dim i As Long
|
||
Dim restDays As Object ' Dictionary
|
||
Dim dateStr As String
|
||
|
||
On Error GoTo ErrorHandler
|
||
|
||
' 确保开始日期小于等于结束日期
|
||
If startDate > endDate Then
|
||
WORKDAYS_CUSTOM_FAST = 0
|
||
Exit Function
|
||
End If
|
||
|
||
' 创建字典对象
|
||
Set restDays = CreateObject("Scripting.Dictionary")
|
||
|
||
' 获取工作表
|
||
Set ws = ThisWorkbook.Sheets("2026年工作日历")
|
||
|
||
' 找到最后一行
|
||
lastRow = ws.Cells(ws.Rows.count, "A").End(xlUp).Row
|
||
|
||
' 将所有休息日加载到字典中（提高查询速度）
|
||
For i = 2 To lastRow
|
||
If ws.Cells(i, 2).Value = "是" Then
|
||
dateStr = Format(CDate(ws.Cells(i, 1).Value), "yyyy-mm-dd")
|
||
restDays(dateStr) = True
|
||
End If
|
||
Next i
|
||
|
||
' 初始化计数器
|
||
workdayCount = 0
|
||
currentDate = startDate
|
||
|
||
' 遍历日期范围
|
||
Do While currentDate <= endDate
|
||
dateStr = Format(currentDate, "yyyy-mm-dd")
|
||
|
||
' 检查是否为休息日
|
||
If Not restDays.Exists(dateStr) Then
|
||
' 不在休息日字典中，说明是工作日
|
||
workdayCount = workdayCount + 1
|
||
End If
|
||
|
||
' 移动到下一天
|
||
currentDate = DateAdd("d", 1, currentDate)
|
||
Loop
|
||
|
||
WORKDAYS_CUSTOM_FAST = workdayCount
|
||
Exit Function
|
||
|
||
ErrorHandler:
|
||
WORKDAYS_CUSTOM_FAST = CVErr(xlErrValue)
|
||
End Function |