VBA工作日截止日期处理及数据验证问题求助

问题1：数据验证报错修复 #

原代码存在两处导致验证失败的问题：

• Info3与Info4之间缺失And连接词，语法不完整
• Deadline是Date类型，无法直接与空字符串比较，且CDate转换空单元格会触发运行时错误

修复方案 #

1. 先验证源单元格内容是否为有效日期，再赋值给Deadline
2. 修正If语句的语法错误，用布尔值判断日期有效性

修改后的关键代码片段：

Dim Deadline As Variant ' 用Variant避免空值转换报错
Dim isDeadlineValid As Boolean

' 验证并转换截止日期
If IsDate(planilhaOrigem.Range("D30").Value) Then
    Deadline = CDate(planilhaOrigem.Range("D30").Value)
    isDeadlineValid = True
Else
    isDeadlineValid = False
End If

' 修正后的完整验证条件
If Info1 <> "" And Info2 <> "" And Info3 <> "" And Info4 <> "" And _
   Info5 <> "" And Info6 <> "" And Info7 <> "" And isDeadlineValid Then
    ' 后续数据写入逻辑...
End If

问题2：截止日期自动调整为最近工作日 #

通过自定义函数实现日期调整，自动跳过周六周日（可扩展支持法定节假日）。

实现步骤 #

1. 添加自定义日期调整函数
2. 在生成初始日期和每次递增日期后调用该函数

自定义函数代码

' 将日期调整为最近工作日（周六→周五，周日→周一）
Function GetAdjustedWorkday(inputDate As Date) As Date
    Dim dayOfWeek As Integer
    dayOfWeek = Weekday(inputDate, vbMonday) ' 周一=1，周日=7
    
    Select Case dayOfWeek
        Case 6 ' 周六
            GetAdjustedWorkday = inputDate - 1
        Case 7 ' 周日
            GetAdjustedWorkday = inputDate + 1
        Case Else ' 工作日
            GetAdjustedWorkday = inputDate
    End Select
End Function

调用调整函数的代码位置

' 初始日期调整
dataAtual = GetAdjustedWorkday(Deadline)

' 循环中递增后调整
Do While dataAtual <= dataLimite
    ' 写入数据逻辑...
    
    dataAtual = DateAdd("d", intervalo, dataAtual)
    dataAtual = GetAdjustedWorkday(dataAtual) ' 调整为工作日
    proximoID = proximoID + 1
Loop

如果需要支持法定节假日，可替换自定义函数为Excel内置的Workday函数：

Function GetAdjustedWorkday(inputDate As Date) As Date
    ' 自动跳过法定节假日（需确保Excel启用分析工具库）
    GetAdjustedWorkday = Application.Workday(inputDate, 0)
End Function

完整修改后的代码示例 #

' 自定义日期调整函数
Function GetAdjustedWorkday(inputDate As Date) As Date
    Dim dayOfWeek As Integer
    dayOfWeek = Weekday(inputDate, vbMonday)
    
    Select Case dayOfWeek
        Case 6
            GetAdjustedWorkday = inputDate - 1
        Case 7
            GetAdjustedWorkday = inputDate + 1
        Case Else
            GetAdjustedWorkday = inputDate
    End Select
End Function

' 主逻辑代码
Sub SaveData()
    Dim Deadline As Variant
    Dim isDeadlineValid As Boolean
    Dim dataAtual As Date
    Dim dataLimite As Date
    Dim intervalo As Integer
    Dim Period As String
    Dim Info1, Info2, Info3, Info4, Info5, Info6, Info7, Info12 As String
    Dim tabelaDestino As ListObject
    Dim proximoID As Integer
    
    ' 假设已初始化planilhaOrigem、tabelaDestino等对象
    Period = planilhaOrigem.Range("XX").Value ' 替换为实际Period单元格
    Info1 = planilhaOrigem.Range("XX").Value ' 替换为实际单元格
    ' 其他Info变量同理赋值
    
    ' 验证截止日期
    If IsDate(planilhaOrigem.Range("D30").Value) Then
        Deadline = CDate(planilhaOrigem.Range("D30").Value)
        isDeadlineValid = True
    Else
        isDeadlineValid = False
    End If
    
    ' 设置周期间隔
    Select Case Period
        Case "Weekly"
            intervalo = 7
        Case "Monthly"
            intervalo = 30
        Case "Bimonthly"
            intervalo = 60
        Case "Quarterly"
            intervalo = 90
        Case "Annual"
            intervalo = 365
        Case Else
            intervalo = 0
    End Select
    
    ' 完整数据验证
    If Info1 <> "" And Info2 <> "" And Info3 <> "" And Info4 <> "" And _
       Info5 <> "" And Info6 <> "" And Info7 <> "" And isDeadlineValid Then
       
        dataLimite = DateSerial(2024, 12, 31)
        dataAtual = GetAdjustedWorkday(Deadline)
        
        If Period = "On Demand" Then
            tabelaDestino.ListRows.Add
            With tabelaDestino.ListRows(tabelaDestino.ListRows.Count).Range
                .Cells(1, correspondenciaColunas("Deadline")).Value = dataAtual
                .Cells(1, correspondenciaColunas("Info12")).Value = Info12
                .Cells(1, correspondenciaColunas("Deadline")).NumberFormat = "dd/mm/yyyy"
            End With
        Else
            Do While dataAtual <= dataLimite
                tabelaDestino.ListRows.Add
                With tabelaDestino.ListRows(tabelaDestino.ListRows.Count).Range
                    .Cells(1, correspondenciaColunas("Deadline")).Value = dataAtual
                    .Cells(1, correspondenciaColunas("Info12")).Value = Info12
                    .Cells(1, correspondenciaColunas("Deadline")).NumberFormat = "dd/mm/yyyy"
                End With
        
                dataAtual = DateAdd("d", intervalo, dataAtual)
                dataAtual = GetAdjustedWorkday(dataAtual)
                proximoID = proximoID + 1
            Loop
        End If
    End If
End Sub

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