Question

高分求解：vb6计算次数并转化输出形式.满意会追加50分！

本人不会VB6,请写出代码并复制下面的举例，验证通过。只说方法者勿答，谢谢合作。
如果下面“具体”里面的内容看不明白，请坚持看完，再看举例一定可以明白。
具体：
手动从excel复制粘贴数据到VB6的文本框，每一个单元格中的数据占据文本框的一行。数据被用英文输入法的冒号隔开，冒号两侧紧挨数据，没有空隙。冒号前面为0-9的自然数，冒号后面为前面自然数的次数，这些次数最小为0，最大不限。要求按一个按钮，计算次数并转化输出形式在记事本输出以便后来粘贴使用。
举例（实际要统计数百行,这里仅截取8行,后面的注释是我加上去给你看的,复制时并没有）:
139:12 （注释：1、3、9都是12次）
45:8 （注释：4和5都是8次）
679:4 （注释：6、7、8都是4次）
38:0 （注释：3、8都是0次）
47:3 （注释：4、7都是3次）
259:1 （注释：2、5、9都是1次）
1468:0 （注释：1、4、6、8都是0次）
37:4 （注释：3、7都是4次）
所以在记事本中计算次数并转化的输出格式是
9(17),3(16),1(12),47(11),5(9),6(4),2(1),08(0),

次数计算解释：
以4为例，它的次数就是8+3+0=11；以0为例，它没有出现过，为0次；以8为例，它的次数为0+0=0次；其它数字同理。
转化输出格式解释：
以前是每段数据占据文本框中的一行，现在在记事本里生成的是都放在同一行；以前是冒号后面是次数，现在次数被放在了英文输入法的小括号中；次数按从大到小排列；次数不同的被用英文输入法的逗号隔开；次数相同的放在一起，但是数字小的要放在前面，如11次的47，4放在7前面；0次的08，0放在8前面。比较急用，请写完代码后复制上面的8行数据验证，看看得到的是不是
9(17),3(16),1(12),47(11),5(9),6(4),2(1),08(0),感激不尽!!

Answer 1

Option Explicit

Private Function GetStr(ByVal pString As String) As String

Dim NumCount(9) As Long
Dim Idx As Long, maxIdx As Long
Dim Value() As String
Dim arr() As String
Dim strTmp As String
Dim lngTmp As Long
Dim i As Long, j As Long

arr = Split(pString, vbCrLf) '分行
'分行处理数据
For i = 0 To UBound(arr)
If Len(Trim(arr(i))) > 0 Then
j = InStr(arr(i), ":")
strTmp = Trim(Mid(arr(i), 1, j - 1)) '冒号前的字符串
lngTmp = Val(Mid(arr(i), j + 1)) '冒号后的值
While Len(strTmp) '统计冒号前的每一个值
Idx = Mid(strTmp, 1, 1)
NumCount(Idx) = NumCount(Idx) + lngTmp '累加
If NumCount(Idx) > NumCount(maxIdx) Then
maxIdx = Idx '取累加后的最大值下标
End If
Mid(strTmp, 1, 1) = Chr(32)
strTmp = Trim(strTmp)
Wend
End If
Next

ReDim Value(NumCount(maxIdx)) '按出现最多的值声明一个数组
For i = 0 To 9
Value(NumCount(i)) = Value(NumCount(i)) & i
Next

arr = Value
Idx = 0
For i = NumCount(maxIdx) To 0 Step -1
If Len(Value(i)) > 0 Then
arr(Idx) = Value(i) & "(" & i & ")"
Idx = Idx + 1
End If
Next
ReDim Preserve arr(Idx - 1)
GetStr = Join(arr, ",")

End Function

Private Sub Form_Load()
Text1.Text = "139:12" & vbCrLf & "45:8" & vbCrLf & "679:4" & vbCrLf & "38:0" & vbCrLf & "47:3" & vbCrLf & "259:1" & vbCrLf & "1468:0" & vbCrLf & "37:4"
End Sub

Private Sub Command1_Click()
MsgBox GetStr(Text1.Text)
End Sub

Answer 2

留下邮箱,把源程序发到你邮箱中