連續 & 不連續 之陣列處理方式ex:1~3,5,7,9~11

PKKO

各位大大如題,陣列內的數字已經會依照數字大小進行排序,由小至大
但要如何達到以下效果呢~?(陣列長度不一定)
假設陣列為
1,2,3,5,7,9,10,11 =>1~3,5,7,9~11
1,11=>1,11
5,6,8,9=>5~6,8~9

也就是上一個數字與這個數字是連續的就要用"~"表示,且省略中間數字
但若不是連續的,則以","顯示,且不得省略數字

luhpro

各位大大如題,陣列內的數字已經會依照數字大小進行排序,由小至大
但要如何達到以下效果呢~?(陣列長度不一定 ...
PKKO 發表於 2014-11-16 05:04

1. Sub nn()
   
2.   Dim iI%
   
3.   Dim lL&
   
4.   Dim sStr$
   
5.   Dim vA, vB
   
6.   
   
7.   'vA = Array(1, 2, 3, 5, 7, 9, 10, 11)
   
8.   'vA = Array(1, 11)
   
9.   vA = Array(5, 6, 8, 9)
   
10.   ReDim vB(0)
    
11.   lL = vA(0)
    
12.   sStr = lL
    
13.   For iI = 1 To UBound(vA)
    
14.     If vA(iI) <> lL + 1 Then
    
15.       If vA(iI - 1) <> sStr Then sStr = sStr & "~" & vA(iI - 1)
    
16.         vB(UBound(vB)) = sStr
    
17.         ReDim Preserve vB(UBound(vB) + 1)
    
18.         sStr = vA(iI)
    
19.     End If
    
20.     lL = vA(iI)
    
21.   Next
    
22.   If vA(UBound(vA)) <> sStr Then sStr = sStr & "~" & vA(iI - 1)
    
23.   vB(UBound(vB)) = sStr
    
24. End Sub

複製代碼

PKKO

回復 2# luhpro

感謝大大的回覆,但無法成功顯示,最後結果只會出現末幾碼而已

GBKEE

回復 3# PKKO
試試看

1. Option Explicit
   
2. '1,2,3,5,7,9,10,11 =>1~3,5,7,9~11
   
3. Sub Ex()
   
4.     Dim Ar(), i As Integer, S As String, Msg As Boolean
   
5.     Ar = Array(1, 2, 3, 5, 6, 9, 10, 11, 15)
   
6.     S = Ar(0)
   
7.     For i = 0 To UBound(Ar)
   
8.         If i = UBound(Ar) Then
   
9.             If Ar(i) - 1 = Ar(i - 1) Then S = S & Ar(i)
   
10.         ElseIf Ar(i) + 1 <> Ar(i + 1) Then
    
11.             If Msg Then S = S & Ar(i) & "," & Ar(i + 1)
    
12.             If Msg = False Then S = S & "," & Ar(i + 1)
    
13.             Msg = False
    
14.         ElseIf Ar(i) + 1 = Ar(i + 1) Then
    
15.            Msg = True
    
16.            S = S & IIf(Right(S, 1) <> "~", "~", "")
    
17.         End If
    
18.     Next
    
19.     MsgBox S
    
20. End Sub

複製代碼

PKKO

回復 4# GBKEE


    感謝版大,完全正確!,且完全明白了!!

bobomi

回復  GBKEE


    感謝版大,完全正確!,且完全明白了!!
PKKO 發表於 2014-11-17 22:46

我很好奇

為何 luhpro大的 , 你會無法成功

我試著ok的

PKKO

Dear 只會出現尾數(8~9)

1. Sub nn()
   
2. 
   
3.   Dim iI%
   
4. 
   
5.   Dim lL&
   
6. 
   
7.   Dim sStr$
   
8. 
   
9.   Dim vA, vB
   
10. 
    
11.   
    
12. 
    
13.   'vA = Array(1, 2, 3, 5, 7, 9, 10, 11)
    
14. 
    
15.   'vA = Array(1, 11)
    
16. 
    
17.   vA = Array(1, 6, 8, 9)
    
18. 
    
19.   ReDim vB(0)
    
20. 
    
21.   lL = vA(0)
    
22. 
    
23.   sStr = lL
    
24. 
    
25.   For iI = 1 To UBound(vA)
    
26. 
    
27.     If vA(iI) <> lL + 1 Then
    
28. 
    
29.       If vA(iI - 1) <> sStr Then sStr = sStr & "~" & vA(iI - 1)
    
30. 
    
31.         vB(UBound(vB)) = sStr
    
32. 
    
33.         ReDim Preserve vB(UBound(vB) + 1)
    
34. 
    
35.         sStr = vA(iI)
    
36. 
    
37.     End If
    
38. 
    
39.     lL = vA(iI)
    
40. 
    
41.   Next
    
42. 
    
43.   If vA(UBound(vA)) <> sStr Then sStr = sStr & "~" & vA(iI - 1)
    
44. 
    
45.   vB(UBound(vB)) = sStr
    
46.     MsgBox vB(UBound(vB))
    
47. End Sub

複製代碼

回復 6# bobomi

Hsieh

1. Sub ex()
   
2. Dim Ay()
   
3. ar = Array(1, 2, 3, 5, 7, 9, 10, 11, 13, 14, 15) '不連續陣列
   
4. For i = 0 To UBound(ar) - 1 ''不處理最後元素
   
5.    j = i
   
6.    x = ar(j)
   
7.       Do Until ar(j) + 1 <> ar(j + 1)
   
8.          j = j + 1
   
9.          If j = UBound(ar) Then Exit Do
   
10.       Loop
    
11.    y = ar(j)
    
12.    i = j
    
13.    ReDim Preserve Ay(s)
    
14.    Ay(s) = IIf(x = y, x, x & "~" & y)
    
15.    s = s + 1
    
16. Next
    
17. If j = UBound(ar) - 1 Then '處理最後元素
    
18. ReDim Preserve Ay(s)
    
19. Ay(s) = ar(UBound(ar))
    
20. End If
    
21. MsgBox Join(Ay, ",")
    
22. End Sub

複製代碼

回復 7# PKKO

GBKEE

回復 7# PKKO
是可以的

1.   vB(UBound(vB)) = sStr
   
2.     MsgBox Join(vB, ",")

複製代碼

PKKO

感謝兩位超版的指教,以及bobomi 的提醒,原來是小弟疏忽了,感恩!!