求一算法，进行字符串转换，在线等，急

Question

求一算法，进行字符串转换传入字符串：
1;2;3;5;9;10;11;16;19;20;21;25
返回
1~3;5;9~11;16;19~21;25;

Answer 1

Option ExplicitPrivate Sub Form_Load()
    Run "1;2;3;5;9;10;11;16;19;20;21;25"
End SubSub Run(strVar As String)
    '传入字符串:
    '1;2;3;5;9;10;11;16;19;20;21;25
    '返回
    '1~3;5;9~11;16;19~21;25;
    Dim strTemp As String
    Dim intI As Integer
    Dim myArray
    myArray = Split(strVar, ";")
    
    For intI = 0 To UBound(myArray) - 1
        If intI > 2 Then
        On Error GoTo Er1
            If (CInt(myArray(intI)) - CInt(myArray(intI - 1))) = 1 _
               And (CInt(myArray(intI - 1)) - CInt(myArray(intI - 2))) = 1 Then
                myArray(intI - 1) = "~"
                '只处理了3位 ,你可以处理你传入的所有位
            End If
Er1:
        End If
    Next
    For intI = 0 To UBound(myArray)
    If myArray(intI) = "~" Then
    strTemp = Left(strTemp, Len(strTemp) - 1) & myArray(intI)
    Else
    
        strTemp = strTemp & myArray(intI) & ";"
        End If
    Next
    Debug.Print strTemp
End Sub

Answer 2

sresult="" 存结果
first=取第一个
sresult=first
isserial 判断是否有连接字符
isserial=false
do while(未读完)
      next=下一个
      if first+1=next then
             if isserial=false
                     sresult=sresult & "~"
                     isserial=true    
              endif
             first=next
             else
                   if isserial=true then
                         sresult= sresult & first & ";"
                    endif
             sresult=sresult & ";" & next 
             first=next
            isserial=false
      endif     
loop
你按这个思路试一下,做好了发点code给我102019896

Answer 3

Dim s As String, begnum As Long, endnum As Long
Dim t As Long
Dim arr As Variant
Dim result As String
s = "1;2;3;5;9;10;11;16;19;20;21;25;26;27"
arr = Split(s, ";")
begnum = arr(LBound(arr))
endnum = begnum
result = ""
For t = LBound(arr) To UBound(arr)
    'If t = UBound(arr) Then Stop
    If arr(t) <= endnum + 1 Then
        endnum = arr(t)
    End If
    If arr(t) > endnum + 1 Or t = UBound(arr) Then
        If begnum = endnum Then
            result = result & begnum
        Else
            result = result & begnum & "-" & endnum
        End If
        If t <> UBound(arr) Then result = result & ";"
        begnum = arr(t)
        endnum = arr(t)
    End If
Next
debug.Print s
debug.Print result1;2;3;5;9;10;11;16;19;20;21;25;26;27
1-3;5;9-11;16;19-21;25-27

Answer 4

来,换个思路.用触发事件的方式.适合处理数据量非常大的字符串:
一个类模块:clsString
Option ExplicitEvent Found(strRead As String, bPos As Integer, ePos As Integer)Private m_strSource As String
Private m_bPos As Integer, m_ePos As IntegerPublic Property Get strSource() As String
    strSource = m_strSource
End PropertyPublic Property Let strSource(ByVal strValue As String)
    m_strSource = strValue
    m_bPos = 1
    m_ePos = Len(strValue)
End PropertyPublic Sub BeginRead()
    Dim i As Integer
    Dim s As String
    If m_ePos = 0 Then
        Err.Raise "未指定源字符串"
        Exit Sub
    End If
    i = m_bPos
    Do While i <= m_ePos
        If i = m_ePos Then
            RaiseEvent Found(Mid(m_strSource, m_bPos, i - m_bPos + 1), m_bPos, i)
        ElseIf Mid(m_strSource, i, 1) = ";" Then
            RaiseEvent Found(Mid(m_strSource, m_bPos, i - m_bPos), m_bPos, i - 1)
            m_bPos = i + 1
        End If
        i = i + 1
    Loop
End SubPrivate Sub Class_Initialize()
    m_bPos = 0
    m_ePos = 0
End Sub一个窗体模块:
Option Explicit
Dim WithEvents objString As clsString
Dim k As Integer
Dim strNew As String
Dim s1 As String, s2 As String, s3 As String, s4 As String
Private Sub Command1_Click()
    k = 1
    strNew = ""
    objString.strSource = "1;2;3;5;9;10;11;16;19;20;21;25"
    objString.BeginRead
    MsgBox strNew
End SubPrivate Sub Form_Load()
    Set objString = New clsString
End SubPrivate Sub objString_Found(strRead As String, bPos As Integer, ePos As Integer)
    Select Case k
        Case 1
            s1 = strRead
            k = k + 1
        Case 2
            s2 = strRead
            k = k + 1
        Case 3
            s3 = strRead
            If strNew = "" Then
                strNew = s1 & "~" & s3
            Else
                strNew = strNew & s1 & "~" & s3
            End If
            k = k + 1
        Case 4
            s4 = strRead
            strNew = strNew & ";" & s4 & ";"
            k = 1
    End Select
End Sub

Answer 5

WithEvents和New 有什么不一样吗?

Answer 6

withEvents 后居然对象可以有事件了........

Answer 7

MSDN里就有啊.在"使用VB"-"部件工具指南"里.

Answer 8

WithEvents和New 有什么不一样吗?
WithEvents就是可以定义对象的事件了,而且只能在申明中定义,且不能实例化.
实例化需要在Form_load里定义.这是用回调的方式来处理,用顺序流的方式,呵呵,学XML时候讲了处理XML文档的两种方式:DOM和简单API,这种就是简单API的实现思路.前面几位的都是DOM的实现思路,处理海量数据时因为都要调入内存,所以不适合---在处理文件流的时候.

Answer 9

谢谢  问一下 你介绍点相关资料好吗?>
MSDN吗?