VBA

Private Const strSheetNm = "Data"

Sub 按钮1_单击()

   Dim wsMain As Worksheet
    Dim strLine As String
    Dim strNo As String
    Dim strArray(100) As Variant
    Dim arrLength As Long
    Dim pos As Integer
   
    Set wsMain = ThisWorkbook.Worksheets(strSheetNm)
    arrLength = 0
   
    With wsMain
        For i = 1 To 500
            strLine = .Cells(i, 4).Value
            .Cells(i, 4).Characters(Start:=1, length:=1).Font.Underline = xlUnderlineStyleDouble
            .Cells(i + 1, 4).Characters(Start:=1, length:=1).Font.Strikethrough = True
            .Cells(i + 2, 4).Characters(Start:=1, length:=1).Font.Strikethrough = True
            If .Cells(i, 4).Characters(Start:=1, length:=1).Font.Underline = xlUnderlineStyleNone Then
                strLine = .Cells(i, 4).Value
            End If
            If strLine <> "" Then
                If IsNumeric(Left(strLine, 1)) Then
                    pos = InStr(1, strLine, " ")
                    If (pos <> 0) Then
                        strNo = Left(strLine, pos)
                        If strNo = "" Or Not IsNumeric(Right(strNo, 1)) Then
                            strNo = Left(strLine, InStr(1, strLine, "　"))
                        End If
                    Else
                        strNo = strLine
                    End If
                    Debug.Print (strNo)
                    strArray(arrLength) = strNo
                    arrLength = arrLength + 1
                End If
            End If
        Next
    End With
    Call CheckStrNO(arrLength - 1, strArray)
End Sub

Function CheckStrNO(size As Integer, ParamArray strArr())
    Dim i As Integer
    Dim str1 As String
    Dim str2 As String
    Dim pos As Integer
    Dim success As Boolean
    Dim errMsg As String
    Dim str1Backup As String
   
    For i = 0 To size
        str1 = strArr(0)(i)
        str2 = strArr(0)(i + 1)
        str1Backup = str1
       
        If str1 = "" Or str2 = "" Then
            success = True
        GoTo MyExit
        End If
       
        If str2 = "1.6" Then
            success = False
        End If
        success = False
       
        If GetNumOfSpecial(str2, ".") <= GetNumOfSpecial(str1, ".") Then
           
            If GetNumOfSpecial(str2, ".") < GetNumOfSpecial(str1, ".") Then
                str1 = Left(str1, Len(str2))
            End If
           
            If IsNumeric(str1) And IsNumeric(str2) Then
                If CDec(str1) = Fix(CDec(str1)) And CDec(str2) = Fix(CDec(str2)) Then
                    If CInt(str2) = CInt(str1) + 1 Then
                        success = True
                    End If
                End If
            End If
           
            If GetLengthOfSpecial(str2, ".") = GetLengthOfSpecial(str1, ".") Then
                pos = GetLengthOfSpecial(str2, ".")
                If Left(str2, pos) = Left(str1, pos) Then
                    If CInt(Right(str2, Len(str2) - pos)) = CInt(Right(str1, Len(str1) - pos)) + 1 Then
                        success = True
                    End If
                End If
            End If
        Else
            If Left(str2, Len(str1)) = str1 And IsNumeric(Right(str2, Len(str2) - Len(str1) - 1)) Then
                success = True
            End If
           
        End If
       
        If Not success Then
            errMsg = str1Backup & " ===> " & str2
            GoTo MyExit
        End If
       
    Next
MyExit:
    If success Then
        MsgBox ("Success!")
    Else
        MsgBox (errMsg)
    End If
       
    CheckStrNO = success

End Function

Function GetLengthOfSpecial(ByRef str As String, ByVal flagStr As String)
    Dim strTmp As String
    Dim pos As Integer
    Dim num As Integer
    Dim length As Integer
   
    num = 0
    pos = 0
    length = 0
    strTmp = str
    Do
        pos = InStr(1, strTmp, flagStr)
        strTmp = Right(strTmp, Len(strTmp) - pos)
        num = num + 1
        length = length + pos
    Loop While pos > 0
   
    GetLengthOfSpecial = length
    Exit Function
   
End Function

Function GetNumOfSpecial(ByRef str As String, ByVal flagStr As String)
    Dim strTmp As String
    Dim pos As Integer
    Dim num As Integer
    Dim length As Integer
   
    num = 0
    pos = 0
    length = 0
    strTmp = str
    Do
        pos = InStr(1, strTmp, flagStr)
        strTmp = Right(strTmp, Len(strTmp) - pos)
        num = num + 1
        length = length + pos
    Loop While pos > 0
   
    GetNumOfSpecial = num
    Exit Function
   
End Function