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