利用vb语言把一组数字分组

Question

比如一组数字[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]应该怎么分 

Answer 1

窗体上加一个 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 LongPrivate Const LB_FINDSTRINGEXACT = &H1A2Private Sub Command1_Click()
Dim strSource As String, strItem() As String, i As Long, n As LongstrSource = "[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 iReDim 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]

Answer 2

Option Explicit' 工程引用： Microsoft Scripting RuntimePrivate Type MembList
   BuffSize    As Long
   MembNum     As Long
   DataBuff()  As Long
End TypePrivate 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 SubPrivate 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

Answer 3

刚才突然想到一个问题，就是：“每个分组内，成员都是一样的”。
因此，数据类型 MembList 没必要用数组把各个成员写入，只要记录值是什么、有多少个就行了。
　　这样的方案，还可以简化数据管理，并提高运行效率。因此我的代码可以简化一下：
Option Explicit' 工程引用： Microsoft Scripting RuntimePrivate Type MembList
   MembNum     As Long
   Value       As Long
End TypePrivate 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 SubPrivate 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

Answer 4

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

Answer 5

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

Answer 6

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,",") '根据 ， 分成 数组 Ufor i=0 to LBound(U)
  U09(cint(U(i))=U09(cint(U(i)) & iif(U09(cint(U(i))="","",",") & cstr(U(i))
nexi iS="["
for i = 0 to 9 
  if U09(i)<>"" then S= iif(s="[","",",") & U09(i) & "]"
next imsgbox S

Answer 7

S="["
for i = 0 to 9 
  if U09(i)<>"" then S= iif(s="[","",",") & S & U09(i) & "]"
next i#13 最后忘了个 S 

Answer 8

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