vab生成排除节假日的日期列

wcj6376tcp

根据AA1选择的月份，从节日表中生成排除节假日日期列
保留公式

感谢cidanji已经完善

蓝桥玄霜

附件有宏病毒，请杀毒后上传。

wcj6376tcp

啥意思，不可能吧


Sub holiday()   '获取法定节假日                                             '
    Dim ar(1 To 24, 1 To 31), dt As Date, r As Long, c As Long
    Dim oDom As Object, oWin As Object, y As Long, md As String
   
    y = Year(Now())
   
    Set oDom = CreateObject("HtmlFile")
    Set oWin = oDom.parentWindow
    With CreateObject("Msxml2.XMLHTTP")
        .Open "GET", "https://timor.tech/api/holiday/year/" & y, False
        .send
        oWin.execScript "jsDict=" & .ResponseText & ".holiday"
    End With
   
    On Error Resume Next
    For dt = DateValue(y & "/1/1") To DateValue(y & "/12/31")
        r = Month(dt) * 2
        c = Day(dt)
        md = Format(dt, "mm-dd")
        ar(r - 1, c) = dt
        ar(r, c) = oWin.eval("jsDict['" & md & "'].name")
        If Weekday(dt, vbMonday) > 5 Then If ar(r, c) = "" Then ar(r, c) = Format(dt, "aaaa")
        If ar(r, c) Like "*补班" Then ar(r, c) = "补班" 'ChrW(9785)
    Next
   
    With Range("A2")
        .CurrentRegion.Clear
        With .Resize(UBound(ar), UBound(ar, 2))
            .Value = ar
            .Font.Size = 10
            .HorizontalAlignment = xlCenter
            .Borders.LineStyle = xlContinuous
        End With
    End With
    Range("A2:AE25").NumberFormatLocal = "yyyy-mm-dd;@"
    Set oWin = Nothing
    Set oDom = Nothing
    Err.Clear
    Beep
End Sub

songshihai

用Excel函数做了一个,感觉没必要用vba

wcj6376tcp

蓝桥玄霜 发表于 2024-7-28 11:07
附件有宏病毒，请杀毒后上传。

加了这段vba代码咋就提示有病毒？不应该吧

wcj6376tcp

songshihai 发表于 2024-7-28 12:44
用Excel函数做了一个,感觉没必要用vba

这样补班也没有了吧？

cidanji

wcj6376tcp

cidanji 发表于 2024-7-28 13:12

你看理解错了我的意思，比如九月，无节日的周末不生成日期，如果是补班需要生成，其他是节假日的日期也不生成，麻烦再修改一下呢？

cidanji

wcj6376tcp 发表于 2024-7-28 13:24
你看理解错了我的意思，比如九月，无节日的周末不生成日期，如果是补班需要生成，其他是节假日的日期也不 ...

wcj6376tcp

cidanji 发表于 2024-7-28 13:12

非常OK，改成这句 If IsDate(x) And (y = "" Or y = "补班") Then就行了，谢谢