|
- Sub 按钮1_Click()
- r = Cells(Rows.Count, 1).End(3).Row
- arr = [a1].Resize(r, 2)
- Set reg = CreateObject("vbscript.regexp")
- reg.Global = True
- reg.Pattern = "\d+"
- For i = 2 To UBound(arr)
- If Len(arr(i, 1)) > 0 Then
- Set mh = reg.Execute(arr(i, 1) & ",@@@9999999999999")
- str1 = Mid(arr(i, 1), mh(0).firstindex, 1) & mh(0).Value
- str2 = ""
- For j = 1 To mh.Count - 1
- If Val(mh(j)) - Val(mh(j - 1)) = 1 Then
- If Left(str1, 1) <> Mid(arr(i, 1), mh(j).firstindex, 1) Then
- If str1 <> Mid(arr(i, 1), mh(j - 1).firstindex, 1) & mh(j - 1).Value Then
- str2 = str2 & "," & str1 & "~" & Mid(arr(i, 1), mh(j - 1).firstindex, 1) & mh(j - 1).Value
- Else
- str2 = str2 & "," & str1
- End If
- str1 = Mid(arr(i, 1), mh(j).firstindex, 1) & mh(j).Value
- End If
-
- Else
- If str1 <> Mid(arr(i, 1), mh(j - 1).firstindex, 1) & mh(j - 1).Value Then
- str2 = str2 & "," & str1 & "~" & Mid(arr(i, 1), mh(j - 1).firstindex, 1) & mh(j - 1).Value
- Else
- str2 = str2 & "," & str1
- End If
- str1 = Mid(arr(i, 1), mh(j).firstindex, 1) & mh(j).Value
- End If
-
- Next j
- arr(i, 1) = Mid(str2, 2)
- arr(i, 2) = mh.Count - 1
- End If
-
- Next i
- arr(1, 2) = "数量"
- [h1].Resize(r, 2) = arr
- End Sub
复制代码 |
|