|
'再试一下,有问题继续上附件
Option Explicit
Sub test()
Dim i, j, k, row, a, b, t
Application.DisplayAlerts = False
row = Cells(Rows.Count, "a").End(xlUp).row + 1
For i = 4 To row
a = getnum(Cells(i, "a").Value)
For j = i + 1 To row
b = getnum(Cells(j, "a"))
If b - a = 1 Then
a = b
Else
t = b
For k = 1 To Len(a)
If Mid(a, k, 1) <> Mid(b, k, 1) Then Exit For
Next
If k = Len(a) + 1 Then
Cells(i, "b").Resize(j - i).Merge
i = j - 1: Exit For
Else
If Val(Mid(b, k)) - Val(Mid(a, k)) = 1 Then
a = t
Else
Cells(i, "b").Resize(j - i).Merge
i = j - 1: Exit For
End If
End If
End If
Next j, i
Application.DisplayAlerts = True
End Sub
Function getnum(t)
Dim i
If Not IsNumeric(t) Then
For i = Len(t) To 1 Step -1
If Not IsNumeric(Mid(t, i, 1)) Then
getnum = CDec(Mid(t, i + 1)): Exit Function
End If
Next
End If
getnum = CDec(t)
End Function |
评分
-
1
查看全部评分
-
|