[已解决]修改代码

雄鹰2013

附件中已有代码是关于编号整合的。但是有缺陷

最佳答案

月排行榜 / 总排行榜

JLxiangwei

2014-7-10 11:30

Sub 编号整合()
Dim rng As Range, i As Long, temp As String, arr(1 To 10000)
[c:c].Clear
[c:c].NumberFormatLocal = "@"
arr(1) = [a1].Text
i = 1
For Each rng In Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
    If Right(arr(i), 5) + 1 = Left(rng.Text, 5) * 1 Then
       arr(i) = Left(arr(i), 5) & "-" & Right(rng.Text, 5)
    Else
       i = i + 1
       arr(i) = rng.Text
    End If
Next rng
[c1].Resize(i) = WorksheetFunction.Transpose(arr)
End Sub


是不是这样的？

跳转到最佳答案楼层

su45

[问题是将相连的编号整合在一起。但是代码有个缺陷就是第一个与第二个单元格不能连在一起。
]

怎么理解“相连的编号整合在一起”？

看不懂！

JLxiangwei

Sub 编号整合()
Dim rng As Range, i As Long, temp As String, arr(1 To 10000)
[c:c].Clear
[c:c].NumberFormatLocal = "@"
arr(1) = [a1].Text
i = 1
For Each rng In Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
    If Right(arr(i), 5) + 1 = Left(rng.Text, 5) * 1 Then
       arr(i) = Left(arr(i), 5) & "-" & Right(rng.Text, 5)
    Else
       i = i + 1
       arr(i) = rng.Text
    End If
Next rng
[c1].Resize(i) = WorksheetFunction.Transpose(arr)
End Sub


是不是这样的？

雄鹰2013

JLxiangwei 发表于 2014-7-10 11:30
Sub 编号整合()
Dim rng As Range, i As Long, temp As String, arr(1 To 10000)
[c:c].Clear

你改的代码符合我的要求，谢谢