生日计算器（区分农历、公历）农历公历互转

wangweihebtu

YZC51 发表于 2020-4-24 20:18
试试

求教，能不能用公历折算成当年的农历，然后再折算成今年的公历？谢谢

YZC51

wangweihebtu 发表于 2020-4-26 07:51
求教，能不能用公历折算成当年的农历，然后再折算成今年的公历？谢谢

可以的，请参考已经更新的3楼附件！

YZC51

如图

YZC51

wangweihebtu 发表于 2020-4-26 07:51
求教，能不能用公历折算成当年的农历，然后再折算成今年的公历？谢谢

请参考已经更新的19楼附件！

YZC51

农历转公历函数（增强功能）

1. Function NltoGl(nlrq, Optional gs As Integer) ' As Date
   
2.     Dim conDate As Date, setDate As Date, tDate As Date
   
3.     Dim valdate, IsGetGl As Boolean, bm$
   
4.     Dim AddMonth As Integer, AddDay As Integer, Addyear As Integer, getDay As Integer
   
5.     Dim i%, nMonth%, Myr%, r1, n1%
   
6.     Dim Sht2 As Worksheet
   
7.     nf = year(Date) + gs - 1
   
8.     yr = Mid(nlrq, 5)
   
9.     If gs Then nlrq = nf & yr
   
10.     Application.ScreenUpdating = False
    
11.     If Len(nlrq) = 0 Then NltoGl = "": Exit Function
    
12.     NYR = Split(nlrq, "-")
    
13.     tYear = NYR(0)
    
14.     tMonth = NYR(1)
    
15.     tDay = NYR(2)
    
16.     'On Error Resume Next
    
17.     If tYear > 2200 Or tYear < 1900 Then Exit Function          '不是有效日期则退出过程
    
18.     Call nonglibm
    
19.     bm = Nlbm(tYear)
    
20.     Addyear = tYear                                             '农历正月初一的公历年份
    
21.     AddMonth = Val(Mid(bm, 15, 2))                              '农历正月初一的公历月份
    
22.     AddDay = Val(Mid(bm, 17, 2))                                '农历正月初一的公历日序
    
23.     conDate = DateSerial(Addyear, AddMonth, AddDay)             '农历正月初一的公历日期
    
24.    
    
25.     AddDay = tDay
    
26.     If InStr(1, tMonth, "闰") > 0 Then
    
27.         nMonth = Val(Mid(tMonth, 2)) + 1
    
28.     Else
    
29.         nMonth = tMonth
    
30.         If Val("&H" & Mid(bm, 14, 1)) > 0 And tMonth > Val("&H" & Mid(bm, 14, 1)) Then nMonth = tMonth + 1
    
31.     End If
    
32.     For i = 1 To nMonth - 1
    
33.         AddDay = AddDay + 29 + Val(Mid(bm, i, 1))
    
34.     Next i
    
35.     setDate = DateAdd("d", AddDay - 1, conDate) - x
    
36.     NltoGl = Format(setDate, "yyyy-mm-dd")
    
37.     Application.ScreenUpdating = True
    
38. End Function

复制代码

cheyuze

wangweihebtu 发表于 2020-4-26 07:51
求教，能不能用公历折算成当年的农历，然后再折算成今年的公历？谢谢

我的1L也就是这样的逻辑的~

cheyuze

YZC51 发表于 2020-4-26 13:15
农历转公历函数（增强功能）

这个相对原来的是更新增强了什么内容哇？~

YZC51

试试
=NltoGl(B2)
=NltoGl(B2,1)
=NltoGl(B2,2)
=NltoGl(B2,3)

YZC51

在19楼附件中的公农历互转表格中输入

zhengrui-csb

农历是用vba弄出来的？能不能用函数或者数组什么的实现？谢谢