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

cheyuze

YZC51 发表于 2020-4-25 13:50
跟老师学习下。谢谢老师！
3楼附件已经更新，请各位老师重新下载！

把工具简化了真好！！膜拜学习了！
另外这一次我发现我们的理解的一个不一样，哈哈，我做的C列是要求输入实际出生日期（公历）的，然后通过B列是公历还是农历来换算真实生日。
层主做的逻辑是通过B列描述C列输入的生日是公历还是农历

cheyuze

YZC51 发表于 2020-4-25 13:50
跟老师学习下。谢谢老师！
3楼附件已经更新，请各位老师重新下载！

看到文件简化了！膜拜学习！哈哈，不过这次我发现是我们两个人的理解逻辑不太一样~
我做的文件逻辑：要求输入的生日为实际出生日期（公历），然后通过B列填写的习惯过农历or公历生日来换算真实的生日日期。
层主的文件逻辑：B列是对C列输入生日的描述，B列写公历就要求C列是公历的，B列写农历就要求C列是农历的从而换算真实的生日日期

如果我的理解是正确我们的excel在使用逻辑上是不一样的话，现在的这个附件存在两个我没明白的BUG/问题：
1、第四行，小小生日如果是农历的2月30的话，比如我写的2019-2-30，D列内容会识别成三月初一
2、以前三行举例，如果B列选择的是农历，那么D列的NltoGL函数会报错从而显示空白，这个我查过原因，猜测是因为它不识别日期格式及“yyyy/mm/dd”，只识别"yyyy-mm-dd"形式的文本格式。
碍于原因2，输入生日的时候需要特意变成文本格式不太方便，所以建议使用我的逻辑：输入生日就输入实际公历生日，或者再加一个辅助列完成日期格式-文本格式的转化，再或者就是要更改下VBA代码啦

niko88819

平常小师妹 都是手机版的提醒,真的非常好用跟大家分享一下,可以参考一下,国历跟农历,天数
https://www.wandoujia.com/apps/256715

YZC51

cheyuze 发表于 2020-4-25 15:09
看到文件简化了！膜拜学习！哈哈，不过这次我发现是我们两个人的理解逻辑不太一样~
我做的文件逻辑：要求 ...

老师好！
1、当实际农历不存在2月30时（当月农历最后一天是29时）自动纠正位3月初一；
2、本附件没有发现这种情况！

YZC51

图片

cheyuze

YZC51 发表于 2020-4-25 16:04
图片

这难倒是版本问题导致的？？我用的是office2019家庭学生版

YZC51

您好！可能是版本问题，2007版
公历转农历可以用下面函数试试。
D2=IF(C2="","",IFERROR(IF(B2="公历",gltonl(C2,7),nongli(NltoGl(C2))),"生日错误！"))

Function gltonl(valdate As Date, Optional gs As Integer = 0) As String '每当闰月的日期多一天，已经校正
'公历转农历函数       '数据校对于 2018-8-31 校对者:yzc51
Dim conDate As Date, setDate As Date, tg$, dz$, nlyear$
Dim AddMonth As Integer, AddDay As Integer, Addyear As Integer, getDay As Integer
Dim tMonth As Integer, tDay As Integer, tYear As Integer, i%
Dim RunYue As Boolean, md$, dd$, mm$, YougetDate As Date
    If valdate = "0:00:00" Then Exit Function
    tYear = year(valdate)
    tMonth = month(valdate)
    tDay = day(valdate)
    On Error Resume Next
    If tYear > 2200 Or tYear < 1900 Then gltonl = "": Exit Function
    Call nonglibm
    Addyear = tYear
    RunYue = False
   
XUNHUAN:
    AddMonth = Val(Mid(Nlbm(Addyear), 16, 1))
    AddDay = Val(Mid(Nlbm(Addyear), 17, 2))
    conDate = DateSerial(Addyear, AddMonth, AddDay)
    setDate = DateSerial(tYear, tMonth, tDay)  '***
    getDay = DateDiff("d", conDate, setDate)
    If getDay < 0 Then Addyear = Addyear - 1: GoTo XUNHUAN
    AddDay = 1: AddMonth = 1: AddMonth1 = 1
    For i = 1 To getDay
        AddDay = AddDay + 1
        If AddDay = 30 + Mid(Nlbm(Addyear), AddMonth1, 1) Or (RunYue And AddDay = 30 + Mid(Nlbm(Addyear), 13, 1)) Then
            If RunYue = False And AddMonth = Val("&H" & Mid(Nlbm(Addyear), 14, 1)) Then
                RunYue = True
                AddMonth1 = AddMonth1 + 1
            Else
                RunYue = False
                AddMonth = AddMonth + 1
                AddMonth1 = AddMonth1 + 1
            End If
            AddDay = 1
        End If
    Next
   
    md$ = "初一初二初三初四初五初六初七初八初九初十十一十二十三十四十五十六十七十八十九二十廿一廿二廿三廿四廿五廿六廿七廿八廿九三十"
    dd$ = Mid(md$, (AddDay - 1) * 2 + 1, 2)
    mm$ = Mid("正二三四五六七八九十冬腊", AddMonth, 1) + "月"
    If RunYue Then mm$ = "闰" + mm$
    tg = Mid(Tiangan$, ((Addyear - 4) Mod 10) + 1, 1)
    dz = Mid(DiZhi$, ((Addyear - 4) Mod 12) + 1, 1)
    nlyear = tg & dz & "年"
    gltonl = nlyear + mm$ + dd$
    If gs = 1 Then gltonl = Addyear & "-" & IIf(RunYue, "闰", "") & AddMonth & "-" & AddDay
    If gs = 2 Then gltonl = Addyear & "年" & mm$ & dd$
    If gs = 3 Then gltonl = Addyear
    If gs = 4 Then gltonl = IIf(RunYue, "闰", "") & AddMonth
    If gs = 5 Then gltonl = AddDay
    If gs = 6 Then gltonl = Mid(ShuX$, ((Addyear - 4) Mod 12) + 1, 1)
    If gs = 7 Then gltonl = "农历" & nlyear & "(" & Mid(ShuX$, ((Addyear - 4) Mod 12) + 1, 1) & ")" & mm$ + dd$
End Function

YZC51

试试
D2=IF(C2="","",IFERROR(IF(B2="公历",gltonl(C2,7),gltonl(NltoGl(C2),7)),"生日错误！"))
可以完全摆脱 NongLi 函数！

YZC51

附件请参考
【新】生日查看工具-2.2.zip (315.98 KB, 下载次数: 188)

2020-4-26 13:32 上传

点击文件名下载附件

YZC51

niko88819 发表于 2020-4-25 15:38
平常小师妹 都是手机版的提醒,真的非常好用跟大家分享一下,可以参考一下,国历跟农历,天数
https://www.wan ...

谢谢老师分享！很好用！