利用vb語言把一組數字分組

比如一組數字[1,2,3,4,5,4,4,4,2,2,1,1,6]，分為[1,1,1],[3],[2,2,2],[4,4,4,4],[5],[6]應該怎么分 

uj5u.com熱心網友回復：

給你個思路吧
第一步，排序，至于用什么方法你自己定，什么冒泡的什么二分的辦法太多，不介紹了。
第二步，做一個回圈，當前這一個與上一個是相同的就放在同一個組中，不同的另起一組。

uj5u.com熱心網友回復：

表單上加一個 ListBox，Sorted 屬性設定為 True。

Option Explicit

Private Declare Function SendMessagebyString Lib _

"user32" Alias "SendMessageA" (ByVal hWND As Long, _

ByVal wMsg As Long, ByVal wParam As Long, _

ByVal lParam As String) As Long



Private Const LB_FINDSTRINGEXACT = &H1A2



Private Sub Command1_Click()

Dim strSource As String, strItem() As String, i As Long, n As Long



strSource = "[1,2,3,4,5,4,4,4,2,2,1,1,6]"



strSource = Replace(Replace(Replace(strSource, "[", ""), "]", ""), " ", "")

strItem = Split(strSource, ",")



List1.Clear

For i = 0 To UBound(strItem)

    n = SendMessagebyString(List1.hWND, LB_FINDSTRINGEXACT, -1, strItem(i))

    

    If n = -1 Then

        List1.AddItem strItem(i)

        List1.ItemData(List1.NewIndex) = 1

    Else

        List1.ItemData(n) = List1.ItemData(n) + 1

    End If

Next i



ReDim strItem(List1.ListCount - 1)

For i = 0 To List1.ListCount - 1

    strItem(i) = "["

    For n = 1 To List1.ItemData(i) - 1

        strItem(i) = strItem(i) & List1.List(i) & ","

    Next n

    strItem(i) = strItem(i) & List1.List(i) & "]"

    Debug.Print strItem(i)

Next i

Debug.Print Join(strItem, ",")

End Sub

結果：
[1,1,1]
[2,2,2]
[3]
[4,4,4,4]
[5]
[6]
[1,1,1],[2,2,2],[3],[4,4,4,4],[5],[6]

uj5u.com熱心網友回復：

Option Explicit



' 工程參考： Microsoft Scripting Runtime



Private Type MembList

   BuffSize    As Long

   MembNum     As Long

   DataBuff()  As Long

End Type



Private Type GroupInfo

   ListSize    As Long

   GroupNum    As Long

   GroupList() As MembList

End Type



 ' *** 按“下標從0開始”處理陣列 ***

Private stcDataGroup As GroupInfo      ' 分組資訊管理變數



' * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

' * *    將一組資料進行分組

' * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

Private Sub Grouping(DataList() As Long)

   Dim objDict As Dictionary

   Dim p As Long, n As Long, v As Long

   Dim i As Long

   ' 初始化分組資訊

   stcDataGroup.ListSize = 16

   stcDataGroup.GroupNum = 0

   ReDim stcDataGroup.GroupList(stcDataGroup.ListSize - 1)

   ' 開始處理資料

   Set objDict = New Dictionary

   For i = 0 To UBound(DataList)

      v = DataList(i)

      If (objDict.Exists(v)) Then

         p = objDict.Item(v)

         With stcDataGroup.GroupList(p)

            p = .MembNum

            If (p = .BuffSize) Then

               n = p + 4      ' 擴充串列長度。如果串列長度多數較大，宜取稍大的值。

               ReDim Preserve .DataBuff(n - 1)

               .BuffSize = n

            End If

            .DataBuff(p) = v

            .MembNum = p + 1  '

         End With

      Else

         p = stcDataGroup.GroupNum

         objDict.Add v, p

         'n = stcdatagroup.GroupList(p).MembNum

         If (p = stcDataGroup.ListSize) Then       '增加組數

            n = p + 8

            ' 每次擴充8個，可按你的需要改。組數多，宜取稍大的值。

            ' 每次擴充數大些，運行效率高點。

            stcDataGroup.ListSize = n

            ReDim Preserve stcDataGroup.GroupList(n - 1)

         End If

         ' 初始化新分組

         With stcDataGroup.GroupList(p)

            n = 16      '設定每組初始大小。分組長度大，就宜取稍大的值。

            .BuffSize = n

            ReDim .DataBuff(n - 1)

            .MembNum = 1

            .DataBuff(0) = v

         End With

         stcDataGroup.GroupNum = p + 1

      End If

   Next

   objDict.RemoveAll

End Sub



' * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

' * *    將分組資料輸出示例（分組資訊調取示例）

' * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

Private Sub ListGroup()

   Dim i&, j&

   

   For i = 0 To stcDataGroup.GroupNum - 1

      Debug.Print "第 " & i + 1 & " 組資料："

      For j = 0 To stcDataGroup.GroupList(i).MembNum - 1

         Debug.Print stcDataGroup.GroupList(i).DataBuff(j);

      Next

      Debug.Print

   Next

End Sub



Private Sub Command1_Click()

   Dim aData() As Long

   Dim i&, sTxtBuf$()

   

   sTxtBuf = Split("1,2,3,4,5,4,4,4,2,2,1,1,6", ",")

   ReDim aData(UBound(sTxtBuf))

   For i = 0 To UBound(sTxtBuf)

      aData(i) = sTxtBuf(i)

   Next

   Call Grouping(aData)    ' 資料分組

   Call ListGroup          ' 輸出結果示例

End Sub

uj5u.com熱心網友回復：

牛人真多 哈哈  都是技術大牛

uj5u.com熱心網友回復：

剛才突然想到一個問題，就是：“每個分組內，成員都是一樣的”。
因此，資料型別 MembList 沒必要用陣列把各個成員寫入，只要記錄值是什么、有多少個就行了。
　　這樣的方案，還可以簡化資料管理，并提高運行效率。

因此我的代碼可以簡化一下：

Option Explicit



' 工程參考： Microsoft Scripting Runtime



Private Type MembList

   MembNum     As Long

   Value       As Long

End Type



Private Type GroupInfo

   ListSize    As Long

   GroupNum    As Long

   GroupList() As MembList

End Type



 ' *** 按“下標從0開始”處理陣列 ***

Private stcDataGroup As GroupInfo      ' 分組資訊管理變數



' * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

' * *    將一組資料進行分組

' * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

Private Sub Grouping(DataList() As Long)

   Dim objDict As Dictionary

   Dim p As Long, n As Long, v As Long

   Dim i As Long

   ' 初始化分組資訊

   stcDataGroup.ListSize = 16

   stcDataGroup.GroupNum = 0

   ReDim stcDataGroup.GroupList(stcDataGroup.ListSize - 1)

   ' 開始處理資料

   Set objDict = New Dictionary

   For i = 0 To UBound(DataList)

      v = DataList(i)

      If (objDict.Exists(v)) Then

         With stcDataGroup.GroupList(objDict.Item(v))

            .MembNum = .MembNum + 1

         End With

      Else

         p = stcDataGroup.GroupNum

         objDict.Add v, p

         If (p = stcDataGroup.ListSize) Then       '增加組數

            n = p + 8

            ' 每次擴充8個，可按你的需要改。組數多，宜取稍大的值。

            ' 每次擴充數大些，運行效率高點。

            stcDataGroup.ListSize = n

            ReDim Preserve stcDataGroup.GroupList(n - 1)

         End If

         ' 新分組資料記錄

         stcDataGroup.GroupList(p).MembNum = 1

         stcDataGroup.GroupList(p).Value = v

         stcDataGroup.GroupNum = p + 1

      End If

   Next

   objDict.RemoveAll

End Sub



' * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

' * *    將分組資料輸出示例（分組資訊調取示例）

' * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

Private Sub ListGroup()

   Dim i&, j&

   For i = 0 To stcDataGroup.GroupNum - 1

      Debug.Print "第 " & i + 1 & " 組資料："

      For j = 1 To stcDataGroup.GroupList(i).MembNum

         Debug.Print stcDataGroup.GroupList(i).Value;

      Next

      Debug.Print

   Next

End Sub



Private Sub Command1_Click()

   Dim aData() As Long

   Dim i&, sTxtBuf$()

   

   sTxtBuf = Split("1,2,3,4,5,4,4,4,2,2,1,1,6", ",")

   ReDim aData(UBound(sTxtBuf))

   For i = 0 To UBound(sTxtBuf)

      aData(i) = sTxtBuf(i)

   Next

   Call Grouping(aData)    ' 資料分組

   Call ListGroup          ' 輸出結果示例

End Sub

uj5u.com熱心網友回復：

Private Sub Grouping(DataList() As Long) 中， n As Long, 可以不要了。

后面放大分組數那兒這樣改下：

If (p = stcDataGroup.ListSize) Then       '增加組數

   stcDataGroup.ListSize = p + 8

   ReDim Preserve stcDataGroup.GroupList(p + 7)

End If

uj5u.com熱心網友回復：

VB.NET只要1行：
Dim Result = "1,2,3,4,5,4,4,4,2,2,1,1,6".Split(",").GroupBy(Function(x) x)

uj5u.com熱心網友回復：

參考 樓主 playboyhdy 的回復:

比如一組數字[1,2,3,4,5,4,4,4,2,2,1,1,6]，分為[1,1,1],[3],[2,2,2],[4,4,4,4],[5],[6]應該怎么分 

怎么沒人問，為什么分好后，3要排到達前面？

uj5u.com熱心網友回復：

參考 8 樓 bcrun 的回復:

Quote: 參考 樓主 playboyhdy 的回復:

比如一組數字[1,2,3,4,5,4,4,4,2,2,1,1,6]，分為[1,1,1],[3],[2,2,2],[4,4,4,4],[5],[6]應該怎么分 

怎么沒人問，為什么分好后，3要排到達前面？

因為原始資料3在前面。這不需要特別問。標準的演算法就應該這樣輸出。

uj5u.com熱心網友回復：

參考 8 樓 bcrun 的回復:

Quote: 參考 樓主 playboyhdy 的回復:

比如一組數字[1,2,3,4,5,4,4,4,2,2,1,1,6]，分為[1,1,1],[3],[2,2,2],[4,4,4,4],[5],[6]應該怎么分 

怎么沒人問，為什么分好后，3要排到達前面？

看錯了，標準的演算法應該輸出 1 2 3 4 5 6這樣幾個分組。

uj5u.com熱心網友回復：

參考 8 樓 bcrun 的回復:

Quote: 參考 樓主 playboyhdy 的回復:

比如一組數字[1,2,3,4,5,4,4,4,2,2,1,1,6]，分為[1,1,1],[3],[2,2,2],[4,4,4,4],[5],[6]應該怎么分 

怎么沒人問，為什么分好后，3要排到達前面？

你想得真多啊。

我倒是真沒注意這個。
應該是樓主的失誤吧，要不然，感覺無法解釋這個原因了。

uj5u.com熱心網友回復：

參考 8 樓 bcrun 的回復:

Quote: 參考 樓主 playboyhdy 的回復:

比如一組數字[1,2,3,4,5,4,4,4,2,2,1,1,6]，分為[1,1,1],[3],[2,2,2],[4,4,4,4],[5],[6]應該怎么分 

怎么沒人問，為什么分好后，3要排到達前面？

想過，但是覺得沒有根據，也沒有必要。

uj5u.com熱心網友回復：

dim S as string 

dim U

dim I as long 

dim U09(9) as string

S=[1,2,3,4,5,4,4,4,2,2,1,1,6]

S=right(S,len(S)-1)

S=left(S,len(S)-1) '去掉前后[]



U=split(S,",") '根據 ， 分成 陣列 U



for i=0 to LBound(U)

  U09(cint(U(i))=U09(cint(U(i)) & iif(U09(cint(U(i))="","",",") & cstr(U(i))

nexi i



S="["

for i = 0 to 9 

  if U09(i)<>"" then S= iif(s="[","",",") & U09(i) & "]"

next i



msgbox S

uj5u.com熱心網友回復：

S="["
for i = 0 to 9 
  if U09(i)<>"" then S= iif(s="[","",",") & S & U09(i) & "]"
next i

#13 最后忘了個 S 

uj5u.com熱心網友回復：

 if U09(i)<>"" then S= iif(s="[","",",[") & S & U09(i) & "]"

uj5u.com熱心網友回復：

牛人真多......

uj5u.com熱心網友回復：

代碼真的好多。勉強看得明白吧。。。

轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/132470.html

標籤：VB基礎類

上一篇：求助VB.net中HScrollBar控制元件的用法

下一篇：vb6呼叫google chrome瀏覽器打開頁面