VBA学习笔记七:自定义函数

VBA学习笔记七:自定义函数

要求:第一列生成指定日期范围的所有日期,第二列判断每个日期是否为工作日或节假日,然后让用户选择要写入的位置,最后将内容写入到指定的单元格区域中代码: Sub GenerateDatesAndCheckWorkdays()

Dim startDate As Date, endDate As Date

Dim currentDate As Date

Dim dateRange() As Variant

Dim i As Long

Dim ws As Worksheet

Dim targetRange As Range

' 指定日期范围

startDate = "2024-08-01"

endDate = "2024-08-10"

' 初始化日期数组

ReDim dateRange(1 To (endDate - startDate + 1), 1 To 2)

' 循环生成日期,并判断是否为工作日或节假日

currentDate = startDate

For i = 1 To UBound(dateRange)

dateRange(i, 1) = currentDate

' 调用`CheckWorkDay`函数,检查某个日期是否为工作日

dateRange(i, 2) = CheckWorkDay(currentDate)

currentDate = currentDate + 1

Next i

' 让用户选择指定单元格的左上角位置作为数据写入区域

On Error Resume Next

Set targetRange = Application.InputBox("请选择目标单元格的左上角位置", Type:=8)

On Error GoTo 0

If targetRange Is Nothing Then

MsgBox "操作已取消", vbExclamation

Exit Sub

End If

' 将数组内容写入指定区域

Set targetRange = targetRange.Resize(UBound(dateRange, 1), UBound(dateRange, 2))

targetRange.Value = dateRange

MsgBox "日期和工作日状态已成功写入", vbInformation

End Sub

Function CheckWorkDay(dateValue As Date) As String

Dim response As String

' 调用 `GetWebData` 函数发送HTTP请求,返回服务器响应的内容

response = GetWebData("http://tool.bitefu.net/jiari/?d=" & Format(dateValue, "yyyymmdd"))

' 判断返回的结果是否为0

If response = "0" Then

CheckWorkDay = "工作日"

Else

CheckWorkDay = "节假日"

End If

End Function

Function GetWebData(url As String) As String

' 声明XMLHTTP对象用于发送HTTP请求

Dim httpRequest As Object

Set httpRequest = CreateObject("MSXML2.XMLHTTP.6.0")

' 初始化HTTP请求

httpRequest.Open "GET", url, False

' 发送请求

httpRequest.send

' 将服务器响应的内容返回

GetWebData = httpRequest.responseText

End Function

代码解释:

`GenerateDatesAndCheckWorkdays` 子过程:生成指定日期范围的所有日期,并判断每个日期是否为工作日或节假日

`CheckWorkDay` 函数:通过调用 `GetWebData` 函数发送HTTP请求,检查某个日期是否为工作日,如果返回值为 `"0"`,表示是工作日;否则为节假日

`GetWebData` 函数:发送HTTP GET请求,获取服务器返回的数据,返回服务器响应的内容

特别说明:

函数中使用了 VBA 的 `XMLHTTP` 对象与服务器进行通信,以获取指定URL的响应数据,关于此对象的说明可以参考这个博主写的https://www.cnblogs.com/caidongji/p/16905519.htmlhttps://www.cnblogs.com/caidongji/p/16905519.html

相关推荐

淘宝延长收货可以延长多久时间?规则是什么?
偏振分光棱镜(PBS)知识
365etb为什么关闭账号

偏振分光棱镜(PBS)知识

08-17 👁️ 3880
30首毕业神曲,再听已是曲中人
365bet有手机版吗

30首毕业神曲,再听已是曲中人

07-11 👁️ 448
QQ群群主身份转让指南:步骤及注意事项全解析
日语敬语
365bet有手机版吗

日语敬语

08-02 👁️ 994
对色灯管需要更换吗?对色灯管多久更换一次比较好?
365etb为什么关闭账号

对色灯管需要更换吗?对色灯管多久更换一次比较好?

06-28 👁️ 4716