Board logo

標題: 連續 & 不連續 之陣列處理方式ex:1~3,5,7,9~11 [打印本頁]
作者: PKKO    時間: 2014-11-16 05:04     標題: 連續 & 不連續 之陣列處理方式ex:1~3,5,7,9~11

各位大大如題,陣列內的數字已經會依照數字大小進行排序,由小至大
但要如何達到以下效果呢~?(陣列長度不一定)
假設陣列為
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    時間: 2014-11-16 06:55

各位大大如題,陣列內的數字已經會依照數字大小進行排序,由小至大
但要如何達到以下效果呢~?(陣列長度不一定 ...
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    時間: 2014-11-16 07:19

回復 2# luhpro

感謝大大的回覆,但無法成功顯示,最後結果只會出現末幾碼而已
作者: GBKEE    時間: 2014-11-17 16:06

本帖最後由 GBKEE 於 2014-11-17 16:08 編輯

回復 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    時間: 2014-11-17 22:46

回復 4# GBKEE


    感謝版大,完全正確!,且完全明白了!!
作者: bobomi    時間: 2014-11-17 23:03

回復  GBKEE


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



我很好奇

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

我試著ok的
作者: PKKO    時間: 2014-11-17 23:14

Dear 只會出現尾數(8~9)
  1. Sub nn()

  3.   Dim iI%

  5.   Dim lL&

  7.   Dim sStr$

  9.   Dim vA, vB

  11.   

  13.   'vA = Array(1, 2, 3, 5, 7, 9, 10, 11)

  15.   'vA = Array(1, 11)

  17.   vA = Array(1, 6, 8, 9)

  19.   ReDim vB(0)

  21.   lL = vA(0)

  23.   sStr = lL

  25.   For iI = 1 To UBound(vA)

  27.     If vA(iI) <> lL + 1 Then

  29.       If vA(iI - 1) <> sStr Then sStr = sStr & "~" & vA(iI - 1)

  31.         vB(UBound(vB)) = sStr

  33.         ReDim Preserve vB(UBound(vB) + 1)

  35.         sStr = vA(iI)

  37.     End If

  39.     lL = vA(iI)

  41.   Next

  43.   If vA(UBound(vA)) <> sStr Then sStr = sStr & "~" & vA(iI - 1)

  45.   vB(UBound(vB)) = sStr
  46.     MsgBox vB(UBound(vB))
  47. End Sub
複製代碼
回復 6# bobomi
作者: Hsieh    時間: 2014-11-18 10:54

  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    時間: 2014-11-18 14:15

回復 7# PKKO
是可以的
  1.   vB(UBound(vB)) = sStr
  2.     MsgBox Join(vB, ",")
複製代碼
作者: PKKO    時間: 2014-11-18 21:13

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



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)