中耳炎滴什么药水最好:vb 日期、数字格式处理

Function myF_ctod(ys As String) As Date                          ' 字符串 -> 日期类型

 On Error GoTo ProcError

    Dim i, m, n As String

        m = ""

    For i = 1 To Len(ys)

        n = Mid(ys, i, 1)

        m = m & IIf(n = "." Or n = ",", "-", n)                  ' 规范化例: "2002-02-02"

    Next

    myF_ctod = CDate(m)

ProcError:

    Exit Function

End Function

Function myF_ctos(ymd As String) As String                         ' 日期字符串规格化

    ymd = Trim(ymd)

 On Error GoTo ProcError

    Dim i, m, n As String

        m = ""

    For i = 1 To Len(ymd)

        n = Mid(ymd, i, 1)

        m = m & IIf(n = "." Or n = "," Or n = "/", "-", n)         ' 规范化例: "2002-02-02"

    Next

    myF_ctos = Format(CDate(m), "yyyy.mm.dd")         ' 字符串规范化例: "2002.02.02"

ProcError:

Function F_rqgs(c As String) As String                             ' 日期规格化

         If c = "" Then

            F_rqgs = " "

            Exit Function

         End If

         Dim m, s As String

         StrMsg = Format(c, "yyyy.mm.dd")

            k = Len(StrMsg)

            If k < 6 Or k > 10 Then

               MsgBox "  出生日期格式有误，请修改 ...  ", 48, "  请注意"

               F_rqgs = " "

               Exit Function

            End If

            If k < 10 Then

               m = ""

               For i = 1 To k

                   s = Mid(StrMsg, i, 1)

                   m = m & IIf(s = ".", "/", s)

               Next

               StrMsg = Format(m, "yyyy.mm.dd")

            End If

         F_rqgs = StrMsg

End Function

Function mF_rqgs(s As String) As String                            ' 日期格式

Dim c As String, d As String

    l = Len(s)                                                     ' "yyyy.mm.dd"

    If l = 0 Then mF_rqgs = "": Exit Function

    If l = 6 And IsDate(s) = True Then

       If Mid(s, 3, 1) = "." And Mid(s, 5, 1) = "." Then

          c = Right(s, 1)

          d = Left(s, 2)                                           ' 00.1.1

          s = Mid(s, 4, 1)

          If IsNumeric(c) And IsNumeric(s) And (Val(d) > 0 Or d = "00") Then

             mF_rqgs = IIf(d > 40, "19", "20") & d & ".0" & s & ".0" & c

             Exit Function

          End If

       End If

    End If

    If l <> 3 And IsDate(s) = True Then

       mF_rqgs = Format(s, "yyyy.mm.dd"): Exit Function

    End If

    mF_rqgs = "False"                                              ' 非标准

    Select Case l

           Case 2

                If Val(s) >= 10 Then

                   mF_rqgs = IIf(s > 40, "19", "20") & s

                End If

           Case 4

                If Val(s) >= 1000 Then

                   mF_rqgs = s

                Else                                               ' 56.7

                   If Mid(s, 3, 1) = "." Then

                      c = Right(s, 1)

                      If IsNumeric(c) Then

                         d = Left(s, 2)

                         mF_rqgs = IIf(d > 40, "19", "20") & d & ".0" & c

                      End If

                   End If

                End If

           Case 5                                                  ' 56.07

                If Mid(s, 3, 1) = "." Then

                   c = Right(s, 2)

                   If IsNumeric(c) And Val(c) < 13 Then

                      d = Left(s, 2)

                      mF_rqgs = IIf(d > 40, "19", "20") & d & "." & c

                   End If

                End If

           Case 6                                                  ' 44.5.6

                If Mid(s, 3, 1) = "." And Mid(s, 5, 1) = "." Then

                   c = Right(s, 1)

                   d = Left(s, 2)

                   s = Mid(s, 4, 1)

                   If IsNumeric(c) And IsNumeric(d) And IsNumeric(s) Then

                      mF_rqgs = IIf(d > 40, "19", "20") & d & ".0" & s & ".0" & c

                   End If

                Else

                   If Mid(s, 5, 1) = "." Then                      ' 2000.5

                      c = Right(s, 1)

                      d = Left(s, 4)

                      If IsNumeric(c) And IsNumeric(d) Then

                         mF_rqgs = d & ".0" & c

                      End If

                    End If

                End If

           Case 7

                If Mid(s, 3, 1) = "." And Val(Left(s, 2)) >= 1 Then

                   d = Left(s, 2)

                   If Mid(s, 5, 1) = "." Then                      ' 58.5.12

                      c = Right(s, 2)

                      s = Mid(s, 4, 1)

                      If Val(c) >= 1 And Val(s) >= 1 Then

                         mF_rqgs = IIf(d > 40, "19", "20") & d & ".0" & s & "." & c

                      End If

                   Else

                      If Mid(s, 6, 1) = "." Then                   ' 58.01.1

                         c = Right(s, 1)

                         s = Mid(s, 4, 2)

                         If Val(c) >= 1 And Val(s) >= 1 Then

                            mF_rqgs = IIf(d > 40, "19", "20") & d & "." & s & ".0" & c

                         End If

                      End If

                   End If

                Else

                   If Mid(s, 5, 1) = "." Then                      ' 1972.10

                      c = Right(s, 2)

                      d = Left(s, 4)

                      If Val(c) >= 1 And Val(c) >= 1 Then

                         mF_rqgs = s

                      End If

                   End If

                End If

           Case 8

                If Mid(s, 3, 1) = "." And Mid(s, 6, 1) = "." Then  ' 95.07.08

                   c = Right(s, 2)

                   d = Left(s, 2)

                   s = Mid(s, 4, 2)

                   If Val(c) >= 1 And Val(d) >= 1 And Val(s) >= 1 Then

                      mF_rqgs = IIf(d > 40, "19", "20") & d & "." & s & "." & c

                   End If

                Else                                               ' 1988.5.1

                   If Mid(s, 5, 1) = "." And Mid(s, 7, 1) = "." Then

                      c = Right(s, 1)

                      d = Left(s, 4)

                      s = Mid(s, 6, 1)

                      If Val(c) >= 1 And Val(d) >= 1000 And Val(s) >= 1 Then

                         mF_rqgs = d & ".0" & s & ".0" & c

                      End If

                   End If

                End If

           Case 9

                d = Left(s, 4)

                If d > 1000 Then

                   If Mid(s, 5, 1) = "." And Mid(s, 7, 1) = "." Then      ' 1988.5.12

                      c = Right(s, 2)

                      s = Mid(s, 6, 1)

                      If Val(c) >= 1 And Val(s) >= 1 Then

                         mF_rqgs = d & ".0" & s & "." & c

                      End If

                   Else

                      If Mid(s, 5, 1) = "." And Mid(s, 8, 1) = "." Then   ' 1988.05.1

                         c = Right(s, 1)

                         s = Mid(s, 6, 2)

                         If Val(c) >= 1 And Val(s) >= 1 Then

                            mF_rqgs = d & "." & s & ".0" & c

                         End If

                      End If

                   End If

                End If

           Case 10

                If Mid(s, 5, 1) = "." And Mid(s, 8, 1) = "." Then

                   d = Left(s, 4)

                   c = Right(s, 2)                                 ' 1988.05.12

                   s = Mid(s, 6, 2)

                   If Val(d) >= 1000 And Val(s) >= 1 And Val(c) >= 1 Then

                      mF_rqgs = d & "." & s & "." & c

                   End If

                End If

    End Select

    If mF_rqgs = "False" Then

       StrMsg = "  日期应按下列格式输入: " & vbCrLf & vbCrLf & _

                "  yyyy.mm.dd 或 yy-mm-dd 或 yy/mm/dd ...  " & vbCrLf

       MsgBox StrMsg, 48, "  请注意"

    End If

End Function

Function myF_ifmt(m As Integer, n As Integer) As String

    myF_ifmt = Space(n - Len(Str(m))) & Str(m)

End Function