【求助】关于Text2每行排序问题，敬请大侠们帮助！

#2

wds12018-08-03 08:16

只有本站会员才能查看附件，请登录

增加了一段排序
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

#3

风吹过b2018-08-03 11:09

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循环结束

#4

风吹过b2018-08-03 11:11

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

#5

风吹过b2018-08-03 11:12

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         '显示结果

#6

回头一看2018-08-03 18:38

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

#7

回头一看2018-08-03 19:04

回复 4楼风吹过b

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

#8

ZHRXJR2018-08-04 00:42

回复楼主回头一看

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

只有本站会员才能查看附件，请登录

在 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编辑过]

#9

风吹过b2018-08-04 09:23

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

#10

xzlxzlxzl2018-08-04 15:35

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

程序代码：

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

#11

回头一看2018-08-04 19:28

得到众版主的支持，非常感谢，谢谢！！！

#12

回头一看2018-08-06 20:50

回复 10楼 xzlxzlxzl

请教大师      n(k) = n(k) & m(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 = "赵,钱,孙,陈"        '统计过程中，受限于这个值，如这里是4个姓，统计重复“孙,孙,孙,”就出错，
                             ‘假如 s = "赵,钱,孙,陈,黄"  这里是5个姓，统计重复“孙,孙,孙,”没问题，
    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

#13

xzlxzlxzl2018-08-07 19:06

回复 12楼回头一看

一个低级Bug，把语句“ReDim n(UBound(m))”修改为“ReDim n(len(t)/2)”即可。

#14

回头一看2018-08-07 21:07

回复 13楼 xzlxzlxzl

谢谢大师！！！

【求助】 关于Text2每行排序问题，敬请大侠们帮助！