排序要按00次到最多次顺序排列

[此贴子已经被作者于2018-8-2 21:52编辑过]

增加了一段排序
 ReDim key1(dd.Count)
 For i = 0 To dd.Count - 1: key1(i) = kk(i): Next
 For i = 0 To dd.Count - 2
 For j = i + 1 To dd.Count - 1
    If key1(i) > key1(j) Then
      T = key1(i): key1(i) = key1(j): key1(j) = T
    End If
 Next j

1、要统计的姓，建二个数组。一个数组保存每一个姓，不管你是使用 split 分解得到，还是一行一行的赋值，都可以的。一个数组为 整数 ，用于统计用的。
2、统计
   一级循环开始
      取一个姓名，截取姓
         二级FOR循环开始
           姓与 姓的每一个数组元素比较
              相同，
                第二个数组 以循环变量为下标 的元素 +1
              退出循环。
         二级FOR循环结束
            判断循环终止值，是否在 范围内，不在的如何处理。此种情况未要求。放弃处理。
     一级循环结束
3、输出结果
   建输出数组2个，一个为字符型A，一个为数值型B。数组大小为 0-10
   for循环开始 I
      判断 第二个数组（I） 是否小于10，是
        A（第二个数组（I））＝ A（第二个数组值（I）） & 第一个数组（I） & ","
        B（第二个数组（I））＝ B（第二个数组值（I）） + 1
      否
         按要求丢弃，不处理 。
   for循环结束
   for循环开始 I
       组合成每一行 ，姓名连接在 A 里，计数在B里面，统计到的人次在循环变量。
   for循环结束

楼主是熟练 JS 或 VBS 的吗？
写的代码，我看不懂。无从下手修改。

Const 最大人次 = 6                  '这个值你没说明是固定还是依据统计的最大值。这里是取固定。如果需要取最大值，需要在 统计每个姓出现的次数里，再加一个判断取最大值

Dim t() As String, s As String      'VB6要求每个变量的类型需要显式申明，未显式申明的统统是 Variant 数据类型
Dim i As Long, j As Long
Dim x() As String, xl() As Long
Dim jg() As String, jgl() As Long
Dim s2 As String
   
    Text2.Text = ""             '清空结果
    s = "赵,钱,孙,李,周,吴,郑,王,冯,陈,褚,卫,蒋,沈,韩,杨,朱,秦,尤,许,何,吕,施,张,孔,曹"     '统计姓的范围
   
    t = Split(Trim(Text1.Text), ",")             '统计内容，去首尾空格，然后分解成数组
   
    x = Split(s, ",")       '统计姓范围分解成数组
    i = UBound(x)
    ReDim xl(i)             '初始化姓统计数组
        
    '-------统计每个姓出现的次数--------
    For i = 0 To UBound(t)          '外循环，需要统计的内容
        For j = 0 To UBound(x)      '内循环，统计的姓
            If t(i) = x(j) Then     '找到相同的姓
                xl(j) = xl(j) + 1   '结果 +1
                Exit For            '这个姓不需要再找了
            End If
        Next j
    Next i
   
    ReDim jg(最大人次)      '初始化最终结果数组
    ReDim jgl(最大人次)
    '---------统计每组出现的姓及个数------------
    For i = 0 To UBound(x)
        If xl(i) <= 最大人次 Then       '是否在最大人次范围内，防止出现错误
            jg(xl(i)) = jg(xl(i)) & x(i) & ","      '组合 姓 列表
            jgl(xl(i)) = jgl(xl(i)) + 1     '结果+1
        End If
    Next i
    '-----组合最终结果-----
    For i = 0 To 最大人次
        s2 = s2 & "【共" & i & "人次】：" & jg(i) & "(" & jgl(i) & "个姓）" & vbCrLf            '组合结果
    Next i
   
    Text2.Text = s2         '显示结果
   

刚上路的新手，谢谢大侠们帮忙！！！把这个问题解决了。

这个写法明快简要我喜欢，谢谢版主！！！
Const 最大人次 = 6       '这个值不是固定值。这有时大有时小不固定。
那再加一个判断取最大值怎么写，请版主帮忙一下，谢谢！！!

你的程序没有多大问题，就是没有对数组排序，只要排序就可以了。

在 kk = dd.keys 语句下面与 For i = 0 To dd.Count - 1 上面增加排序就可以了：
    kk = dd.keys

    For i = 0 To dd.Count - 2
        For j = i To dd.Count - 1
            If kk(i) > kk(j) Then
                PL = kk(i): kk(i) = kk(j): kk(j) = PL
            End If
        Next j
    Next i

    For i = 0 To dd.Count - 1
上面代码部分就是排序语句。

[此贴子已经被作者于2018-8-4 00:49编辑过]

dim 最大人次 as long           '最大值需要定义为一个变量

    '-------统计每个姓出现的次数--------
    最大人次=0
    For i = 0 To UBound(t)          '外循环，需要统计的内容
        For j = 0 To UBound(x)      '内循环，统计的姓
            If t(i) = x(j) Then     '找到相同的姓
                xl(j) = xl(j) + 1   '结果 +1
                if 最大人次 < xl(j) then 最大人次=xl(j)            '找最大值
                Exit For            '这个姓不需要再找了
            End If
        Next j
    Next i

不排序也可得到结果，代码如下（其中“卫孙”和“褚吴”作为复姓不在索引表里未统计，所以和题主结果有出入）：

Private Sub Command1_Click()
    Dim i As Integer, j As Integer, k As Integer, m() As String, n() As String, s As String, t As String
    s = "赵,钱,孙,李,周,吴,郑,王,冯,陈,褚,卫,蒋,沈,韩,杨,朱,秦,尤,许,何,吕,施,张,孔,曹"
    t = Text1.Text & ","
    m = Split(s, ",")
    ReDim n(UBound(m))
    For i = 0 To UBound(m)
      j = 1
      k = 0
      While InStr(j, t, m(i) & ",")
        k = k + 1
        j = InStr(j, t, m(i) & ",") + 1
      Wend
      n(k) = n(k) & m(i) & ","
    Next
    Text2 = ""
    For i = 0 To UBound(n)
      If n(i) <> "" Then
        Text2 = Text2 & "【共" & i & "人次】：" & n(i) & "(" & Len(n(i)) / 2 & "个姓)" & vbCrLf
      End If
    Next
End Sub

Private Sub Form_Load()
Text1.Text = "钱,孙,李,周,吴,郑,王,冯,陈,褚,卫,蒋,沈,韩,杨,钱,孙,李,周,吴,冯,陈,褚,卫孙,李,周,吴,郑,孙,李,周,吴,郑,王,冯,陈,褚,卫,蒋,王,冯,陈,褚吴,郑,王,冯,陈,,李,周,吴,,冯,陈,褚"
End Sub