求一算法

[billow_chentao]

一记录集合里有数据如下：
1
2
3
8
10
11
12
把它变成：
1-3,8,10-12

[benyfeifei]

Private Sub Command1_Click()

Dim a() As Integer

ReDim a(0 To 9) As Integer

a(0) = 1
a(1) = 2
a(2) = 3
a(3) = 8
a(4) = 10
a(5) = 11
a(6) = 13
a(7) = 20
a(8) = 4
a(9) = 22
MsgBox CombineString(a)

End Sub
'冒泡法排序
Sub Sort(data() As Integer)

Dim i As Integer, j As Integer

Dim temp As Integer


For i = LBound(data) To UBound(data)

For j = i + 1 To UBound(data)
temp = data(i)
If data(j) < temp Then
data(i) = data(j)
data(j) = temp
End If
Next
Next
End Sub
Function CombineString(data() As Integer) As String

Dim ret As String
Dim blnContinuous As Boolean

Dim i As Integer

On Error GoTo ErrHandle

'对数组就行从小到大排序
Call Sort(data)

ret = CStr(data(LBound(data)))

For i = LBound(data) + 1 To UBound(data)

If data(i) = data(i - 1) + 1 Then

If i = UBound(data) Then ret = ret & CStr(data(i))

If Not blnContinuous Then ret = ret & "-"

blnContinuous = True
Else

If blnContinuous Then ret = ret & CStr(data(i - 1))

ret = ret & "," & CStr(data(i))

blnContinuous = False
End If
Next
CombineString = ret
Exit Function

ErrHandle:
CombineString = ""
End Function

[viena]

题意不明

[viena]

楼主没有说明，给出的数字是举例，还是就是实际的范围，比如月份
如果是月份的话，没有那么复杂，
1到12循环
判断1是否在集合中，然后递增，找到一个作为第一组起始，若某一个数不在其中，终止一组，得到下一组的起始

[billow_chentao]

那些记录集合不是固定范围，是十六位长度的编号。

[billow_chentao]

我顶 我顶 我顶顶顶

[billow_chentao]

benyfeifei(狒狒) 的方法是行，但我的数子位数太多，还是有问题。
我的数字有16位甚至更长，用Long型都不行。
怎么办呢？

[benyfeifei]

我给你的函数不行吗？

[笨狗先飞]

有没有排序排好呢?

举个例子
如果没有排序的话,先排一下序~~
排好之后按下面的步骤操作
arr()为事先排好的数
dim varstart ,varend ,var
dim c as long ,i as long
c=ubound(arr)
varstart=arr(0)
varend=arr(0)
for i=1 to c
var=arr(i)
if var-1=varend then
varend=var
else
if varstart=varend then
debug.print varstart & ",";
else
debug.print varstart & "-" & varend & ",";
end if
varstart=var
varend=var
end if
next
只是说明一下思路,与实际使用可能还有距离~

[benyfeifei]

那用Double行吗？

[billow_chentao]

用Double类型显示出来是“1E+20”这样的数字没人能看懂啊，有没有办法把“1E+20”变成“99999999999999999999”如果可以问题就解决了？？？？

[KiteGirl]

少等！看本人一会儿给你一个惊天地泣鬼神的算法！！！

[billow_chentao]

小仙妹，你的神仙算法在哪里呢？

[KiteGirl]

这几天忙别的，暂时没顾得上。

想实现integer和long类型的这种算法很容易。但是你要求16位以上就麻烦一些。问题是：你记录集合里的数字是什么格式的？我必须要知道你原来的数据是什么格式才能给你个具体的算法。

[笨狗先飞]

哈哈~~,小仙妹果然是惊天地泣鬼神~~~

[KiteGirl]

现有算法是这样的：

Type tpSect
seOn As Long
seEnd As Long
End Type

Function SectUniteByLong(ByRef pDatas() As Long) As tpSect
Dim tOutSects() As tpSect
Dim tOutSects_Lenght As Long

ReDim tOutSects(tOutSects_Lenght)

With tOutSects(tOutSects_Lenght)
.seOn = pDatas(0)
.seEnd = pDatas(0)
End With

Dim tDatas_Index As Long
Dim tDatas_Lenght As Long

tDatas_Lenght = UBound(pDatas())

Dim tDatas_Limit As Long
Dim tDatas_Limit_Append As Boolean
Dim tDatas_Limit_Create As Boolean

For tDatas_Index = 1 To tDatas_Lenght
With tOutSects(tOutSects_Lenght)
tDatas_Limit = pDatas(tDatas_Index) - .seEnd
End With

tDatas_Limit_Append = tDatas_Limit = 1
tDatas_Limit_Create = tDatas_Limit > 1
If tDatas_Limit_Append Then
With tOutSects(tOutSects_Lenght)
.seEnd = pDatas(tDatas_Index)
End With
ElseIf tDatas_Limit_Create Then
tOutSects_Lenght = tOutSects_Lenght + 1
ReDim Preserve tOutSects(tOutSects_Lenght)
With tOutSects(tOutSects_Lenght)
.seOn = pDatas(tDatas_Index)
.seEnd = pDatas(tDatas_Index)
End With
End If
Next

SectUniteByLong = tOutSects()
End Function

如果是16位以上的数据，需要源数据格式做一下修改。如果你能保证提供String格式的数据，即使几千位我也有办法。

[yzx99]

感觉benyfeifei(狒狒)的足够好了,剩下数据是整型还是长整型或是字符这应该是小问题,楼主自己可以处理好,或是另开新贴讨论.