- Sub test()
- Dim i As Integer, j%, k%, x%, m%, n%
- Dim arr(1 To 3, 1 To 1)
- For x = 14 To 38
- k = 0
- For n = 1 To Len(Cells(x, 3))
- k = k + 1
- arr(k, 1) = Mid(Cells(x, 3), n, 1)
- Next n
- For i = 1 To UBound(arr)
- For j = i + 1 To UBound(arr)
- If arr(i, 1) > arr(j, 1) Then
- m = arr(i, 1)
- arr(i, 1) = arr(j, 1)
- arr(j, 1) = m
- End If
- Next
- Next
- Cells(x, 4) = "'" & Join(Application.Transpose(arr), "")
- Next x
- End Sub
复制代码 |