VBA写入公式（2）：日期公式集

weixin_46655338

已于 2022-07-27 20:27:25 修改

阅读量892

点赞数

分类专栏： VBA 文章标签：自动化

于 2022-05-17 13:46:30 首次发布

本文链接：https://blog.csdn.net/weixin_46655338/article/details/124798047

版权

VBA 专栏收录该内容

7 篇文章 1 订阅

订阅专栏

Sub 日期公式集()
    '先选择数字所在的一个单元格，在选择大写金额保存的一个单元格。
    '&两边无空格是公式上的连接符，&两边有空格是vba上的连接符。
    '带有双引号的外面必须由两重双引号，而且最内侧双引号外不能连接其他字符串。
    
    'n = MsgBox("计算剩余日期" & vbCrLf & "选择【重试】：选项2" & vbCrLf & "选择【忽略】：选项3", vbAbortRetryIgnore, "提示")
    'n = MsgBox("选择【终止】：选项1" & vbCrLf & "选择【重试】：选项2" & vbCrLf & "选择【忽略】：选项3", vbAbortRetryIgnore, "提示")
    'Debug.Print n
'    UserForm1.Show
'    Case 1
'    MsgBox "你选择了1"
    inpu = Application.InputBox("请输入数字（先判断是否为日期格式）。  1、计算剩余日期，如1年1月1日；  2、计算剩余天数，如1天；  3、带“.”日期转化为年月日格式;   4、日期格式转带“.”。   5、连续数字（即非日期格式，如19900101）转年月日格式。  6、日期格式转斜杠格式（如1990/1/1）    7、日期格式转斜杠格式（如1990-1-1）", Type:=1)
    Set rng1 = Application.InputBox(prompt:="鼠标选择数据源的一个单元格", Type:=8)
    a = rng1.Address(0, 0)
    Set rng2 = Application.InputBox(prompt:="鼠标选择保存结果一个单元格", Type:=8)
    '有些是文本格式，但是也可以计算正确的剩余时间。此处只是作提醒。
    If IsDate(rng1) = False Then MsgBox ("选中的单元格不是日期格式，可能计算结果错误或者程序报错。")
    Select Case inpu
        Case 1
            rng2.Formula = "=IFERROR(IF(DATEDIF(TODAY()," & a & "," & """y""" & ")=0," & """""" & ",DATEDIF(TODAY()," & a & "," & """y""" & ")&" & """年""" & ")&IF(DATEDIF(TODAY()," & a & "," & """ym""" & ")=0,IF(DATEDIF(TODAY()," & a & "," & """y""" & ")=0," & """""" & ",IF(DATEDIF(TODAY()," & a & "," & """md""" & ")=0," & """整""" & "," & """零""" & ")),IF(DATEDIF(TODAY()," & a & "," & """md""" & ")=0,DATEDIF(TODAY()," & a & "," & """ym""" & ")&" & """个月整""" & ",DATEDIF(TODAY()," & a & "," & """ym""" & ")&" & """个月""" & "))&IF(DATEDIF(TODAY()," & a & "," & """md""" & ")=0," & """""" & ",DATEDIF(TODAY()," & a & "," & """md""" & ")&" & """天""" & ")," & """""" & ")"
            'Cells(row2, colu2).Formula = "=IFERROR(IF(DATEDIF(TODAY(),a," & """y""" & ")=0," & """""" & "1" & "," & """""" & ")"
        Case 2
            rng2.Formula = "=IFERROR(" & a & "-TODAY()," & """""" & ")"
        Case 3
            '少输入=运行程序写入单元格，可以看到转化为Excel原公式的样子。
            'rng2.Formula = "TEXT(SUBSTITUTE(" & a & "," & """.""" & "," & """-""" & ")," & """yyyy年m月d日""" & ")"
            rng2.Formula = "=TEXT(SUBSTITUTE(" & a & "," & """.""" & "," & """-""" & ")," & """yyyy年m月d日""" & ")"
        Case 4
            rng2.Formula = "=TEXT(" & a & "," & """yyyy.mm.dd""" & ")"
        Case 5
            rng2.Formula = "=TEXT(TEXT(" & a & "," & """0000-00-00""" & ")," & """yyyy年m月d日""" & ")"
        Case 6
            rng2.Formula = "=TEXT(" & a & "," & """yyyy/m/d""" & ")"
        Case 7
            rng2.Formula = "=TEXT(" & a & "," & """yyyy-m-d""" & ")"
        Case Else
            MsgBox "请按要求输入数字"
    End Select
        
End Sub


'Case4 : 如何将横线日期变为点分隔日期.输入公式【=TEXT(A2,"yyyy.m.d")】或【=TEXT(A2,"e.m.d"】，带零则是输入公式=TEXT(C3,"e.mm.dd"),

详细版：

Sub 日期公式集()
    '先选择数字所在的一个单元格，在选择大写金额保存的一个单元格。
    '&两边无空格是公式上的连接符，&两边有空格是vba上的连接符。
    '带有双引号的外面必须由两重双引号，而且最内侧双引号外不能连接其他字符串。
    
    'n = MsgBox("计算剩余日期" & vbCrLf & "选择【重试】：选项2" & vbCrLf & "选择【忽略】：选项3", vbAbortRetryIgnore, "提示")
    'n = MsgBox("选择【终止】：选项1" & vbCrLf & "选择【重试】：选项2" & vbCrLf & "选择【忽略】：选项3", vbAbortRetryIgnore, "提示")
    'Debug.Print n
    '    UserForm1.Show
    '    Case 1
    '    MsgBox "你选择了1"
    
    On Error Resume Next
    '已使用的字母：abcdef
    Set rng1 = Application.InputBox(prompt:="鼠标选择数据源的一个单元格", Type:=8)
    a = rng1.Address(0, 0)
    Set rng2 = Application.InputBox(prompt:="鼠标选择保存结果一个单元格", Type:=8)
    b_rc = rng2.Address ' $A$1，双重锁定 lock row and column
    b = rng2.Address(0, 0) 'A1, unlock row and column
    b_r = rng2.Address(1, 0) 'A$1, rng1.Address(行, 列)，锁定行就是锁定A1中的1.
    b_c = rng2.Address(0, 1) '$A1
    
    row_rng2 = rng2.Row
    colu_rng2 = rng2.Column
    valu_rng1 = rng1.Value
    c = Cells(row_rng2, colu_rng2 + 1).Address(0, 0)
    d = Cells(row_rng2, colu_rng2 + 2).Address(0, 0)
    e = Cells(row_rng2, colu_rng2 + 3).Address(0, 0)

    
    
    
    inpu1 = Application.InputBox("请输入数字，选择数据源的日期格式。                       1、年月日；        2、年月；       3、星期；      4、时间段（两个日期在同一单元格）        5、时间段（两个日期在不同单元格，例子：1日、3日隔1日）；", Type:=1)
    
    Select Case inpu1
        Case 1  '年月日
            'inpu2 = Application.InputBox("请输入数字,选择数据源的日期格式。                   1、日期格式，如2022年4月25日；  2022-4-25；  2022/4/25；   二〇二二年四月二十五日；                 2、文本格式，如2022.4.25  ", Type:=1)
            If IsDate(valu_rng1) Then     '数据源为日期格式。
                inpu3 = Application.InputBox _
                ("请输入数字,选择生成的日期格式。                           1、2022年4月25日；              2、2022-4-25；                3、2022/4/25；                  4、二〇二二年四月二十五日；                  10、2022.4.25            11、2022.04.25                            15、星期几                16、是否为周末                   17、日期+星期（2022-4-25换行（一）)                           18、转连续数字格式：20220425                            21、农历：2022年3月25日（WPS计算农历是假的）                     22、农历：三月二十五日                   23、农历：辛寅年 七月二十一日                           24、农历年：辛寅年                         26、剩余几年几月几日（例子：1日、3日隔1日）", Type:=1)
                  
                Select Case inpu3
                    Case 1
                        rng2.Formula = "=TEXT(" & a & "," & """e年m月d日""" & ")"
                    Case 2
                        rng2.Formula = "=TEXT(" & a & "," & """yyyy-m-d""" & ")"
                        
                    Case 3
                        rng2.Formula = "=TEXT(" & a & "," & """e/m/d""" & ")"
                    Case 4
                        rng2.Formula = "=TEXT(" & a & "," & """yyyy-m-d""" & ")"
                    Case 10
                        rng2.Formula = "=TEXT(" & a & "," & """yyyy.m.d""" & ")"
                    Case 11
                        rng2.Formula = "=TEXT(" & a & "," & """yyyy.mm.dd""" & ")"
                    Case 15
                        '=TEXT(WEEKDAY(A3,1),"AAAA")
                        rng2.Formula = "=TEXT(WEEKDAY(" & a & ",1)," & """AAAA""" & ")"
                    Case 16
                        '=IF(MOD(C3,7)<2,"周末","非周末")
                        rng2.Formula = "=IF(MOD(" & a & ",7)<2," & """周末""" & "," & """非周末""" & ")"
                    Case 17
                        'CHOOSE(WEEKDAY(A5),"日","一","二","三","四","五","六")
                        '=TEXT(A3,"yyyy-m-d")&CHAR(10)&"（"&CHOOSE(WEEKDAY(A3),"日","一","二","三","四","五","六")&"）"
                        'form_chos_week = "CHAR(10)&CHOOSE(WEEKDAY(" & a & ")," & """日""" & "," & """一""" & "," & """二""" & "," & """三""" & "," & """四""" & "," & """五""" & "," & """六""" & ")"
                        'rng2.Formula = "=" & form_chos_week
                        'rng2.Formula = "=TEXT(" & a & "," & """yyyy-m-d""" & ")" & "&" & "（" & form_chos_week & "）"
                        'rng2.Formula = "=" & a
                        'rng2.Formula = "=TEXT(" & a & "," & """yyyy-m-d""" & ")" & "&" & """（""" & "&" & form_chos_week & "&" & """）"""
                        'formula choose week
                        form_chos_week = "CHOOSE(WEEKDAY(" & a & ")," & """日""" & "," & """一""" & "," & """二""" & "," & """三""" & "," & """四""" & "," & """五""" & "," & """六""" & ")"
                        'rng2.Formula = "=TEXT(" & a & "," & """m月d日""" & ")" & "&" & "char(10)" & "&" & """（""" & "&" & form_chos_week & "&" & """）"""
                        rng2.Formula = "=TEXT(" & a & "," & """m月d日""" & ")&CHAR(10)&" & """（""" & "&" & form_chos_week & "&" & """）"""
                    Case 18  '日期格式转连续数字格式，如转为20220425
                        '=TEXT(C18,"emmdd")
                        rng2.Formula = "=TEXT(" & a & "," & """emmdd""" & ")"
                    
                    
                    Case 21
                        '=TEXT(A1,"[$-130000]YYYY年M月D日")
                        rng2.Formula = "=TEXT(" & a & "," & """[$-130000]e年m月d日""" & ")"
                    Case 22   '农历三月二十五日
                        '=TEXT(A2," [$-130000][DBNum1]m月d日")
                        rng2.Formula = "=TEXT(" & a & "," & """[$-130000][DBNum1]m月d日""" & ")"
                    Case 23    '农历辛寅年 七月二十一日
                        'MID(" 甲乙丙丁戊己庚辛壬癸",MOD(TEXT(NOW(),"[$-130000]e")-4,10)+1,1)&MID("子丑寅卯辰巳午未申酉 戌亥",MOD(TEXT(NOW(),"[$-130000]e")-4,12)+1,1)&"年"&TEXT(NOW()," [$-130000][DBNum1]m月d日")
                        rng2.Formula = "=MID(" & """ 甲乙丙丁戊己庚辛壬癸""" & ",MOD(TEXT(" & a & "," & """[$-130000]e""" & ")-4,10)+1,1)&MID(" & """子丑寅卯辰巳午未申酉 戌亥""" & ",MOD(TEXT(" & a & "," & """[$-130000]e""" & ")-4,12)+1,1)&" & """年""" & "&TEXT(" & a & "," & """ [$-130000][DBNum1]m月d日""" & ")"
                    Case 24    '农历年：辛寅年
                        rng2.Formula = "=MID(" & """ 甲乙丙丁戊己庚辛壬癸""" & ",MOD(TEXT(" & a & "," & """[$-130000]e""" & ")-4,10)+1,1)&MID(" & """子丑寅卯辰巳午未申酉 戌亥""" & ",MOD(TEXT(" & a & "," & """[$-130000]e""" & ")-4,12)+1,1)&" & """年"""
                    Case 26     '剩余几年几月几日
                         rng2.Formula = "=IFERROR(IF(DATEDIF(TODAY()," & a & "," & """y""" & ")=0," & """""" & ",DATEDIF(TODAY()," & a & "," & """y""" & ")&" & """年""" & ")&IF(DATEDIF(TODAY()," & a & "," & """ym""" & ")=0,IF(DATEDIF(TODAY()," & a & "," & """y""" & ")=0," & """""" & ",IF(DATEDIF(TODAY()," & a & "," & """md""" & ")=0," & """整""" & "," & """零""" & ")),IF(DATEDIF(TODAY()," & a & "," & """md""" & ")=0,DATEDIF(TODAY()," & a & "," & """ym""" & ")&" & """个月整""" & ",DATEDIF(TODAY()," & a & "," & """ym""" & ")&" & """个月""" & "))&IF(DATEDIF(TODAY()," & a & "," & """md""" & ")=0," & """""" & ",DATEDIF(TODAY()," & a & "," & """md""" & ")&" & """天""" & ")," & """""" & ")"
                         'Cells(row2, colu2).Formula = "=IFERROR(IF(DATEDIF(TODAY(),a," & """y""" & ")=0," & """""" & "1" & "," & """""" & ")"
                         
                         
                End Select
            ElseIf InStr(valu_rng1, ".") Then  '带“.”的非文本日期格式。
            
                'replace_result = Replace(valu_rng1, ".", "-")
                'rng2.Value = replace_result
                                    '=TEXT(SUBSTITUTE(G3,".","-"),"yyyy年m月d日")
                    rng2.Formula = "=TEXT(SUBSTITUTE(" & a & "," & """.""" & "," & """-""" & ")," & """yyyy年m月d日""" & ")"
                    
                    'rng2.Formula = "=TEXT(" & a & "," & """yyyy-m-d""" & ")"
                    'rng2.Formula = "=TEXT(" & a & "," & """e年m月d日""" & ")"
                    
            ElseIf Len(valu_rng1) = 8 Then    '连续文本数字格式：20220425
                '=TEXT(J3,"00-00-00")
                rng2.Formula = "=TEXT(" & a & "," & """00-00-00""" & ")"
                On Error GoTo 0
            Else
                 MsgBox ("数据源格式不能转化，请按照要求修改数据源格式。")
            End If
         
        Case 4 '时间段（两个日期在同一个单元格）
            inpu4 = Application.InputBox("请输入数字,选择数据源的时间段格式及保存格式。                                     1、“至”字分割，保存成2列：2022-1-11至2022-4-25      2022/1/11至2022/4/25       2022.01.11至2022.4.25                     2、“-”分割，保存成2列：2022/1/11-2022/4/25      2022.01.11-2022.4.25                              3、“至”字分割，保存成4列                            4、“-”分割，保存成4列", Type:=1)
            
            Select Case inpu4
                Case 1     '“至”字分割，保存成2列
                    rng2.Formula = "=TEXT(SUBSTITUTE(LEFT(" & a & ",FIND(" & """至""" & "," & a & ")-1)," & """.""" & "," & """-""" & ")," & """yyyy年m月d日""" & ")"
                    
                    'Cells(rng2.Row, rng2.Column + 1) = "=IFERROR(RIGHT(" & a & ",LEN(" & a & ")-FIND(" & """至""" & "," & a & "))," & """""" & ")"
                    
                    
                    '=IFERROR(TEXT(SUBSTITUTE(RIGHT(A34,LEN(A34)-FIND("至",A34)),".","-"),"yyyy年m月d日"),"")
                    Cells(row_rng2, colu_rng2 + 1) = "=IFERROR(TEXT(SUBSTITUTE(RIGHT(" & a & ",LEN(" & a & ")-FIND(" & """至""" & "," & a & "))," & """.""" & "," & """-""" & ")," & """yyyy年m月d日""" & ")," & """""" & ")"
                Case 2     '“-”分割，保存成2列
                    '=IFERROR(LEFT(E12,FIND("-",E12)-1),"")         =IFERROR(RIGHT(E12,LEN(E12)-FIND("-",E12)),"")  =TEXT(SUBSTITUTE(O12,".","-"),"yyyy年m月d日")
                    '=TEXT(SUBSTITUTE(LEFT(E12,FIND("-",E12)-1),".","-"),"yyyy年m月d日")
                    
                    'rng2.Formula = "=TEXT(SUBSTITUTE(LEFT(" & a & ",FIND(" & """-""" & "," & a & ")-1)," & """.""" & "," & """-""" & ")," & """yyyy年m月d日""" & ")"
                    rng2.Formula = "=IFERROR(TEXT(SUBSTITUTE(LEFT(" & a & ",FIND(" & """-""" & "," & a & ")-1)," & """.""" & "," & """-""" & ")," & """yyyy-m-d""" & ")," & """""" & ")"
                    Cells(row_rng2, rcolu_rng2 + 1) = "=IFERROR(TEXT(SUBSTITUTE(RIGHT(" & a & ",LEN(" & a & ")-FIND(" & """-""" & "," & a & "))," & """.""" & "," & """-""" & ")," & """yyyy-m-d""" & ")," & """""" & ")"
                Case 3       '“至”字分割，保存成4列
                    '=IFERROR(SUBSTITUTE(LEFT(A39,FIND("至",A39)-1),".","-"),"")        =IFERROR(SUBSTITUTE(RIGHT(A42,LEN(A42)-FIND("-",A42)),".","-"),"")
                    rng2.Formula = "=IFERROR(SUBSTITUTE(LEFT(" & a & ",FIND(" & """至""" & "," & a & ")-1)," & """.""" & "," & """-""" & ")," & """""" & ")"
                    Cells(row_rng2, colu_rng2 + 1) = "=IFERROR(TEXT(SUBSTITUTE(RIGHT(" & a & ",LEN(" & a & ")-FIND(" & """至""" & "," & a & "))," & """.""" & "," & """-""" & ")," & """yyyy-m-d""" & ")," & """""" & ")"
                    Cells(row_rng2, colu_rng2 + 2) = "=TEXT(" & b & "," & """e-m-d""" & ")"
                    Cells(row_rng2, colu_rng2 + 3) = "=TEXT(" & c & "," & """e-m-d""" & ")"
                    
                    
                Case 4       '“-”字分割，保存成4列
                    rng2.Formula = "=IFERROR(SUBSTITUTE(LEFT(" & a & ",FIND(" & """-""" & "," & a & ")-1)," & """.""" & "," & """-""" & ")," & """""" & ")"
                    Cells(row_rng2, colu_rng2 + 1) = "=IFERROR(TEXT(SUBSTITUTE(RIGHT(" & a & ",LEN(" & a & ")-FIND(" & """-""" & "," & a & "))," & """.""" & "," & """-""" & ")," & """yyyy-m-d""" & ")," & """""" & ")"
                    Cells(row_rng2, colu_rng2 + 2) = "=TEXT(" & b & "," & """e-m-d""" & ")"
                    Cells(row_rng2, colu_rng2 + 3) = "=TEXT(" & c & "," & """e-m-d""" & ")"
             
            End Select
        Case 5 '时间段（两个日期在同一个单元格）
            Set rng3 = Application.InputBox(prompt:="鼠标选择第二个日期所在的单元格", Type:=8)
            '=IFERROR(IF(DATEDIF(A52,B52,"y")=0,"",DATEDIF(A52,B52,"y")&"年")&IF(DATEDIF(A52,B52,"ym")=0,IF(DATEDIF(A52,B52,"y")=0,"",IF(DATEDIF(A52,B52,"md")=0,"整","零")),IF(DATEDIF(A52,B52,"md")=0,DATEDIF(A52,B52,"ym")&"个月整",DATEDIF(A52,B52,"ym")&"个月"))&IF(DATEDIF(A52,B52,"md")=0,"",DATEDIF(A52,B52,"md")&"天"),"")
            f = rng3.Address(0, 0) 'A1, unlock row and column
            rng2.Formula = "=IFERROR(IF(DATEDIF(" & a & "," & f & "," & """y""" & ")=0," & """""" & ",DATEDIF(" & a & "," & f & "," & """y""" & ")&" & """年""" & ")&IF(DATEDIF(" & a & "," & f & "," & """ym""" & ")=0,IF(DATEDIF(" & a & "," & f & "," & """y""" & ")=0," & """""" & ",IF(DATEDIF(" & a & "," & f & "," & """md""" & ")=0," & """整""" & "," & """零""" & ")),IF(DATEDIF(" & a & "," & f & "," & """md""" & ")=0,DATEDIF(" & a & "," & f & "," & """ym""" & ")&" & """个月整""" & ",DATEDIF(" & a & "," & f & "," & """ym""" & ")&" & """个月""" & "))&IF(DATEDIF(" & a & "," & f & "," & """md""" & ")=0," & """""" & ",DATEDIF(" & a & "," & f & "," & """md""" & ")&" & """天""" & ")," & """""" & ")"
            
    End Select
End Sub



'=TEXT(SUBSTITUTE(G3,".","-"),"yyyy年m月d日")

'=TEXT(H3,"yyyy.mm.dd")





'vba代码换行符总结
'在定义变量时候 可以使用 _换行

'例如

'Dim a As String, _
'b As String

'对于非sql  语句 可以使用 空格+ _

'例如

'If MsgBox("您确认要清空文本框值吗?", vbOKCancel + vbInformation, "提示") = vbOK Then
    
'    If MsgBox("您确认要清空文本框值吗?", vbOKCancel + _
                vbInformation, "提示") = vbOK Then
'对于 sql 语句 可以在句末+双引号+空格+下划线，下一句前面+&+空格+双引号

'例如

'strsql = "Select 采购订单表.状态, 采购订单表.采购订单号, 采购订单表.采购日期, 采购订单表.供应商ID, 采购订单表.经办人" _
'& " FROM 采购订单表;"
'也可以

'a = "Select 采购订单表.状态, 采购订单表.采购订单号, 采购订单表.采购日期, 采购订单表.供应商ID, 采购订单表.经办人"
'a = a & " FROM 采购订单表;"






'    If inpu < 21 Then
'
'        Set rng1 = Application.InputBox(prompt:="鼠标选择数据源的一个单元格", Type:=8)
'        a = rng1.Address(0, 0)
'        Set rng2 = Application.InputBox(prompt:="鼠标选择保存结果一个单元格", Type:=8)
'        b_rc = rng2.Address ' $A$1，双重锁定 lock row and column
'        b = rng2.Address(0, 0) 'A1, unlock row and column
'        b_r = rng2.Address(1, 0) 'A$1, rng1.Address(行, 列)，锁定行就是锁定A1中的1.
'        b_c = rng2.Address(0, 1) '$A1
'    ElseIf (inpu > 20) And (inpu < 31) Then
'        Set rng1 = Application.InputBox(prompt:="鼠标选择数据源的一个单元格,如A1", Type:=8)
'        a = rng1.Address(0, 0)
'        Set rng2 = Application.InputBox(prompt:="鼠标选择数据源一列一个区间段，如A1：A5", Type:=8)
'        b_rc = rng2.Address ' $A$1，双重锁定 lock row and column
'        b = rng2.Address(0, 0) 'A1, unlock row and column
'        b_r = rng2.Address(1, 0) 'A$1, rng1.Address(行, 列)，锁定行就是锁定A1中的1.
'        b_c = rng2.Address(0, 1) '$A1
'        Set rng3 = Application.InputBox(prompt:="鼠标选择保存结果一个单元格，如B1", Type:=8)
'
'
'    ElseIf (inpu > 30) And (inpu < 41) Then
'        Select Case inpu
'            Case 31
'                MsgBox "接着鼠标选择3列单元格，如：干部，男，2022年1月1日。"
'                Set rng1 = Application.InputBox(prompt:="鼠标选择“干部”所在的一个单元格", Type:=8)
'                a = rng1.Address(0, 0)
'                Set rng2 = Application.InputBox(prompt:="鼠标选择“性别”所在的一个单元格", Type:=8)
'                b = rng2.Address(0, 0) 'A1, unlock row and column
'                Set rng3 = Application.InputBox(prompt:="鼠标选择“出生日期”所在的一个单元格", Type:=8)
'                c = rng3.Address(0, 0)
'                Set rng4 = Application.InputBox(prompt:="鼠标选择保存结果单元格的一个单元格", Type:=8)
'                rng4.Formula = "=IF(" & b & "=" & """男""" & ",EDATE(" & c & ",12*60),IF(" & a & "=" & """干部""" & ",EDATE(" & c & ",12*55),EDATE(" & c & ",12*50)))"
'                '=IF(B2="男",EDATE(C2,12*60),IF(A2="干部",EDATE(C2,12*55),EDATE(C2,12*50)))
'                Exit Sub
'        End Select
'
'
'        '    Else:
'        '        MsgBox "请按要求输入数字"
'        '        Exit Sub
'
'    End If
'
'    'If IsDate(rng1) = False Then MsgBox ("选中的单元格不是日期格式，可能计算结果错误或者程序报错。")
'    Select Case inpu
'        Case 1
'            'rng2.Formula = "=TEXT(Mid(" & a & ",7, 8)," & """00-00-00""" & ")"
'            inpu2 = Application.InputBox("选日期格式请输入数字。  1、1990-11-11；  2、1990/11/11；   3、1990年11月11日；   4、1990.1.1；   5、1990.01.01；     6、1990.01；     7、1990年01月      8、1900年1月         ", Type:=1)
'            If (inpu2 = 1) Or (inpu2 = 2) Or (inpu2 = 3) Or (inpu2 = 4) Or (inpu2 = 5) Or (inpu2 = 6) Or (inpu2 = 7) Or (inpu2 = 8) Then
'                Select Case inpu2
'                    Case 1
'                        rng2.Formula = "=TEXT(Mid(" & a & ",7, 8)," & """0000-00-00""" & ")"
'                    Case 2
'                        rng2.Formula = "=TEXT(TEXT(MID(" & a & ",7, 8)," & """0000-00-00""" & ")" & "," & """e/m/d""" & ")"
'                    Case 3
'                        rng2.Formula = "=TEXT(TEXT(MID(" & a & ",7, 8)," & """0000-00-00""" & ")" & "," & """e年m月d日""" & ")"
'
'                    Case 4
'                        rng2.Formula = "=TEXT(TEXT(MID(" & a & ",7, 8)," & """0000-00-00""" & ")" & "," & """e.m.d""" & ")"
'                    Case 5
'                        rng2.Formula = "=TEXT(TEXT(MID(" & a & ",7, 8)," & """0000-00-00""" & ")" & "," & """e.mm.dd""" & ")"
'                    Case 6
'                        rng2.Formula = "=TEXT(TEXT(MID(" & a & ",7, 8)," & """0000-00-00""" & ")" & "," & """e.mm""" & ")"
'                    Case 7
'                        rng2.Formula = "=TEXT(TEXT(MID(" & a & ",7, 8)," & """0000-00-00""" & ")" & "," & """e年mm月""" & ")"
'                    Case 8
'                        rng2.Formula = "=TEXT(TEXT(MID(" & a & ",7, 8)," & """0000-00-00""" & ")" & "," & """e年m月""" & ")"
'                    Case Else
'                        MsgBox "请按要求输入数字"
'                End Select
'            End If
'
'
'        Case 2
'            rng2.Formula = "=IF(MOD(MID(" & a & ",17,1),2)," & """男""" & "," & """女""" & "）"
'        Case 3
'            '少输入=运行程序写入单元格，可以看到转化为Excel原公式的样子。
'            'rng2.Formula = "TEXT(SUBSTITUTE(" & a & "," & """.""" & "," & """-""" & ")," & """yyyy年m月d日""" & ")"
'            rng2.Formula = "=DATEDIF(TEXT(MID(" & a & ",7,8)," & """00-00-00""" & "),TODAY()," & """y""" & ")"
'
'        Case 4
'            rng2.Formula = "=CHOOSE(MOD(MID(" & a & ",7,4)-1900,12)+1," & """鼠""" & "," & """牛""" & "," & """虎""" & "," & """兔""" & "," & """龙""" & "," & """蛇""" & "," & """马""" & "," & """羊""" & "," & """猴""" & "," & """鸡""" & "," & """狗""" & "," & """猪""" & ")"
'
'        Case 5
'            '            rng2.Formula = "=LOOKUP(--MID(" & a & ",11,4),{321},{" & """白羊座""" & "})"
'            rng2.Formula = "=LOOKUP(--MID(" & a & ",11,4),{120;219;321;420;521;621;723;823;923;1023;1122;1222},{" & """水瓶座""" & ";" & """双鱼座""" & ";" & """白羊座""" & ";" & """金牛座""" & ";" & """双子座""" & ";" & """巨蟹座""" & ";" & """狮子座""" & ";" & """处女座""" & ";" & """天秤座""" & ";" & """天蝎座""" & ";" & """射手座""" & ";" & """摩羯座""" & "})"
'        Case 6
'            rng2.Formula = "=LOOKUP(--LEFT(" & a & ",2),{11,12,13,14,15,21,22,23,31,32,33,34,35,36,37,41,42,43,44,45,46,50,51,52,53,54,61,62,63,64,65,71,81,82},{" & """北京""" & ";" & """天津""" & ";" & """河北""" & ";" & """山西""" & ";" & """内蒙古""" & ";" & """辽宁""" & ";" & """吉林""" & ";" & """黑龙江""" & ";" & """上海""" & ";" & """江苏""" & ";" & """浙江""" & ";" & """安徽""" & ";" & """福建""" & ";" & """江西""" & ";" & """山东""" & ";" & """河南""" & ";" & """湖北""" & ";" & """湖南""" & ";" & """广东""" & ";" & """广西""" & ";" & """海南""" & ";" & """重庆""" & ";" & """四川""" & ";" & """贵州""" & ";" & """云南""" & ";" & """西藏""" & ";" & """陕西""" & ";" & """甘肃""" & ";" & """青海""" & ";" & """宁夏""" & ";" & """新疆""" & ";" & """台湾""" & ";" & """香港""" & ";" & """澳门""" & "})"
'        Case 7
'            rng2.Formula = "=LOOKUP(--LEFT(" & a & ",2),{11,12,13,14,15,21,22,23,31,32,33,34,35,36,37,41,42,43,44,45,46,50,51,52,53,54,61,62,63,64,65,71,81,82},{" & """北京市""" & ";" & """天津市""" & ";" & """河北省""" & ";" & """山西省""" & ";" & """内蒙古自治区""" & ";" & """辽宁省""" & ";" & """吉林省""" & ";" & """黑龙江省""" & ";" & """上海市""" & ";" & """江苏省""" & ";" & """浙江省""" & ";" & """安徽省""" & ";" & """福建省""" & ";" & """江西省""" & ";" & """山东省""" & ";" & """河南省""" & ";" & """湖北省""" & ";" & """湖南省""" & ";" & """广东省""" & ";" & """广西壮族自治区""" & ";" & """海南省""" & ";" & """重庆市""" & ";" & """四川省""" & ";" & """贵州省""" & ";" & """云南省""" & ";" & """西藏自治区""" & ";" & """陕西省""" & ";" & """甘肃省""" & ";" & """青海省""" & ";" & """宁夏回族自治区""" & ";" & """新疆维吾尔自治区""" & ";" & """台湾省""" & ";" & """香港特别行政区""" & ";" & """澳门特别行政区""" & "})"
'
'        Case 8
'            rng2.Formula = "=EDATE(TEXT(MID(" & a & ",7,8)," & """0!/00!/00""" & "),MOD(MID(" & a & ",15,3),2)*120+600)"
'
'        Case 9
'            rng2.Formula = "=REPLACE(" & a & ",7,8," & """********""" & ")"
'
'        Case 21
'            rng3.Formula = "=IF(COUNTIF(" & b_r & "," & a & "&" & """*""" & ")>1," & """重复""" & "," & """""" & ")"
'        Case Else
'            MsgBox "请按要求输入数字"
'    End Select




'出生日期 = Text(Mid(C3, 7, 8), "00-00-00")
'性别=IF(MOD(MID(C3,17,1),2),"男","女")
'
'年龄（周岁） =DATEDIF(TEXT(MID(C3,7,8),"00-00-00"),TODAY(),"y")。

'退休年龄=EDATE(D3,MOD(MID(C3,17,1),2)*120+600)
'判断是否重复=IF(COUNTIF(C$3:C$9,C3&"*")>1,"重复","")
'=EDATE(D3,MOD(MID(C3,17,1),2)*120+600)=EDATE(D3,1*120+600)；否则为=EDATE(D3,0*120+600)，即在出生日期的后面加上720个月（60岁）或者600个月（50岁）即可。


'生肖=CHOOSE(MOD(MID(B2,7,4)-1900,12)+1,"鼠","牛","虎","兔","龙","蛇","马","羊","猴","鸡","狗","猪")。
'不能用：星座=LOOKUP(--TEXT(C2,"mdd"),{101,"摩羯座";120,"水平座";219,"双鱼座";321,"白羊座";420,"金牛座";521,"双子座";621,"巨蟹座";723,"狮子座";823,"处女座";923,"天秤座";1023,"天蝎座";1122,"射手座";1222,"摩羯座"})
'星座=LOOKUP(--MID(E3,11,4),{120;219;321;420;521;621;723;823;923;1023;1122;1222},{"水瓶座";"双鱼座";"白羊座";"金牛座";"双子座";"巨蟹座";"狮子座";"处女座";"天秤座";"天蝎座";"射手座";"摩羯座"})
'https://www.163.com/dy/article/ER1KFJK6053670IG.html
'省份=LOOKUP(--LEFT(F2,2),{11,12,13,14,15,21,22,23,31,32,33,34,35,36,37,41,42,43,44,45,46,50,51,52,53,54,61,62,63,64,65,71,81,82},{"北京市";"天津市";"河北省";"山西省";"内蒙古自治区";"辽宁省";"吉林省";"黑龙江省";"上海市";"江苏省";"浙江省";"安徽省";"福建省";"江西省";"山东省";"河南省";"湖北省";"湖南省";"广东省";"广西壮族自治区";"海南省";"重庆市";"四川省";"贵州省";"云南省";"西藏自治区";"陕西省";"甘肃省";"青海省";"宁夏回族自治区";"新疆维吾尔自治区";"台湾省";"香港特别行政区";"澳门特别行政区"})
'省份简称=LOOKUP(--LEFT(F2,2),{11,12,13,14,15,21,22,23,31,32,33,34,35,36,37,41,42,43,44,45,46,50,51,52,53,54,61,62,63,64,65,71,81,82},{"北京";"天津";"河北";"山西";"内蒙古";"辽宁";"吉林";"黑龙江";"上海";"江苏";"浙江";"安徽";"福建";"江西";"山东";"河南";"湖北";"湖南";"广东";"广西";"海南";"重庆";"四川";"贵州";"云南";"西藏";"陕西";"甘肃";"青海";"宁夏";"新疆";"台湾";"香港";"澳门"})
'退休日期=EDATE(TEXT(MID(A2,7,8),"0!/00!/00"),MOD(MID(A2,15,3),2)*120+600)
'先利用Text函数计算出出生的年月信息，然后用MOD、MID函数计算性别码和2相除的余数，余数是1，则后续的计算就是720个月，也就是男性60年退休，余数是0，就是600个月，女性50年退休。然后再用EDATE函数返回出生年月为准的日期，就自动得出了退休的时间。
'关于身份证号码的6个函数公式实用技巧解读!
'https://www.163.com/dy/article/EFR7RDNO05360SWT.html

'分3种情况：男性60周岁退休、女干部55周岁退休、女工人50周岁退休。
'excel身份证号计算退休日期，我们只需要在D2单元格输入公式：
'=IF(B2="男",EDATE(C2,12*60),IF(A2="干部",EDATE(C2,12*55),EDATE(C2,12*50)))

'=TEXT(C3,"e年m月d日"), 要求C3是日期格式。如不是日期格式，需要先转日期格式：=TEXT(TEXT(G54,"00-00-00"),"e年m月d日")
'=TEXT(TEXT(MID(F62,7,8),"00-00-00"),"e年m月d日")
'星号隐藏=REPLACE(F71,7,8,"********")