怎样输入公历日期自动转换成阴历日期

xgw159

在表格内公历日期栏输入公历日期，在阴历栏自动显示阴历日期

weiqigreen

我的解决思路：
1.通过自定义函数实现
2.类似爬虫，得到信息
3.整理信息并返回

代码：

1. Function nl(gongli_date)
   
2.     Dim HttpReq As Object
   
3.     Dim datas, url, gongli_nian, gongli_yue, gongli_ri, flag1, flag2 As String
   
4.     Dim pos1, pos2 As Integer
   
5.     gongli_nian = Year(gongli_date)
   
6.     gongli_yue = Month(gongli_date)
   
7.     gongli_ri = Day(gongli_date)
   
8.    
   
9.     Set HttpReq = CreateObject("MSXML2.XMLHTTP.6.0")
   
10.     url = "https://gonglinongli.bmcx.com/"
    
11.     datas = "gongli_nian=" & gongli_nian & "&gongli_yue=" & Right("0" & gongli_yue, 2) & "&gongli_ri=" & Right("0" & gongli_ri, 2)
    
12.     HttpReq.Open "Post", url, False
    
13.     HttpReq.setRequestHeader "Content-Length", Len(datas)
    
14.     HttpReq.setRequestHeader "CONTENT-TYPE", "application/x-www-form-urlencoded; charset=utf-8"
    
15.     HttpReq.send datas
    
16.     If HttpReq.Status = 200 Then
    
17.         tmp = HttpReq.responseText
    
18.     End If
    
19.    
    
20.     flag1 = "<td bgcolor=" & Chr(34) & "#F5F5F5" & Chr(34) & " align=" & Chr(34) & "center" & Chr(34) & ">农历</td>"
    
21.     flag2 = "<td bgcolor=" & Chr(34) & "#F5F5F5" & Chr(34) & " align=" & Chr(34) & "center" & Chr(34) & ">生肖</td>"
    
22.     pos1 = InStr(tmp, flag1)
    
23.     pos2 = InStr(tmp, flag2)
    
24.     tmp = Mid(tmp, pos1 + Len(flag1) + 62, pos2 - pos1 - Len(flag2) - 81)
    
25.     pos1 = InStr(tmp, "<div")
    
26.     tmp = Mid(tmp, 1, pos1 - 1)
    
27.     tmp = Replace(tmp, " ", "")
    
28.     nl = tmp
    
29. End Function

复制代码

效果图：



附件：

weiqigreen

我是没回复成功，还是现在审核要很久？

weiqigreen

效果：


代码：

1. Function nongli(gongli_date)
   
2.     '函数说明：通过爬虫，得到农历信息，未使用正则。
   
3.     Dim HttpReq As Object
   
4.     Dim datas, url, gongli_nian, gongli_yue, gongli_ri, flag1, flag2, tmp As String
   
5.     Dim pos1, pos2 As Integer '用于记录位置信息
   
6.     '1.获取年月日
   
7.     gongli_nian = Year(gongli_date)
   
8.     gongli_yue = Month(gongli_date)
   
9.     gongli_ri = Day(gongli_date)
   
10.     '2.设置爬虫
    
11.     Set HttpReq = CreateObject("MSXML2.XMLHTTP.6.0")
    
12.     url = "https://gonglinongli.bmcx.com/"  '网址
    
13.     datas = "gongli_nian=" & gongli_nian & "&gongli_yue=" & Right("0" & gongli_yue, 2) & "&gongli_ri=" & Right("0" & gongli_ri, 2) '参数
    
14.     HttpReq.Open "Post", url, False
    
15.     HttpReq.setRequestHeader "Content-Length", Len(datas)
    
16.     HttpReq.setRequestHeader "CONTENT-TYPE", "application/x-www-form-urlencoded; charset=utf-8"
    
17.     HttpReq.send datas
    
18.     If HttpReq.Status = 200 Then
    
19.         tmp = HttpReq.responseText
    
20.     End If
    
21.     '3.清理数据，拿到农历信息。注：因为正则需要添加库，有的同事电脑上不能直接用。因此，这里未使用正则，看起来一点都不高大上。
    
22.     flag1 = "<td bgcolor=" & Chr(34) & "#F5F5F5" & Chr(34) & " align=" & Chr(34) & "center" & Chr(34) & ">农历</td>"
    
23.     flag2 = "<td bgcolor=" & Chr(34) & "#F5F5F5" & Chr(34) & " align=" & Chr(34) & "center" & Chr(34) & ">生肖</td>"
    
24.     pos1 = InStr(tmp, flag1)
    
25.     pos2 = InStr(tmp, flag2)
    
26.     tmp = Mid(tmp, pos1 + Len(flag1) + 62, pos2 - pos1 - Len(flag2) - 81)
    
27.     pos1 = InStr(tmp, "<div")
    
28.     tmp = Mid(tmp, 1, pos1 - 1)
    
29.     tmp = Replace(tmp, " ", "")
    
30.     nongli = tmp
    
31. End Function

复制代码

修改_蓬莱区祭祀统计表.rar (25.42 KB, 下载次数: 1)

2023-4-5 19:38 上传

点击文件名下载附件

weiqigreen

weiqigreen 发表于 2023-4-5 19:36
我是没回复成功，还是现在审核要很久？

我在CSDN上记录的，审核通过了：https://blog.csdn.net/weiqigreen/article/details/129975416

weiqigreen

我在CSDN上记录的通过审核了。https://blog.csdn.net/weiqigreen/article/details/129975416

静听溪流

https://club.excelhome.net/threa ... tml?_dsign=ed53da17