字符串 比较 重复次数 问题！

[pedkk]

a(i)中存储着　３位数字的　数组．
比如
a(1)=123
a(2)=456
....... 这里数组数量未知．随时都会增加．　范围　i = 1 to h

问题：

如何将所有的数组进行比较，有重复出现的　就记录　当前数组的值　和相应的次数．　

并且在label1(1 to 18) 中　按重复出现次数　从多到少显示出来前１８位　３位数字.

[用户 昵称]

这就是一个自比较，从前往后，两重循环就行了。

[pedkk]

你说这个是吧？
for i = 1 to h
for j = 1 to h
if a(i) = a(j) then
....
end if
end if

你考虑过会出现　重复比较的问题吗？　考虑过提取重复出现的数值和相应次数吗？　提取前１８位````

[可西哥]

类似于哈希,如果是题目,肯定就是了,要不然也不会这么说:"存储着３位数字"
这样说等于是告诉你最多999-100=899个,那就可以确定表大小为899了,
统计一下,然后再排序

[pedkk]

哎`` 没有一个可用的``

[舉杯邀明月]

[Quote=引用 8 楼 pedkk 的回复:]
哎`` 没有一个可用的``
[/Quote]

-_-！！

[vbman2003]

Sub PrintValue(a() As Long)
    Dim i As Long
    Dim p(100 To 999) As Long
    Dim max As Long
    Dim n As Long
    
    For i = 0 To UBound(a)
        p(a(i)) = p(a(i)) + 1
        If p(a(i)) > max Then max = p(a(i))
    Next
    
    n = 1
    Do
        For i = 999 To 100 Step -1
            If p(i) = max Then
                Label1(n) = i & "出现 " & p(i) & " 次"
                n = n + 1
            End If
            If n > 18 Then Exit Sub
        Next
        max = max - 1
    Loop While max
End Sub

[vbman2003]

我是按元素值从大到少输出的，如果要前18位，就改最后一个循环：
Do
For i = 100 To 999
If p(i) = max Then
Label1(n) = i & "出现 " & p(i) & " 次"
n = n + 1
End If
If n > 18 Then Exit Sub
Next
max = max - 1
Loop While max

[波导终结者]

[Quote=引用 11 楼 vbman2003 的回复:]
我是按元素值从大到少输出的，如果要前18位，就改最后一个循环：
Do
For i = 100 To 999
If p(i) = max Then
Label1(n) = i & "出现 " & p(i) & " 次"
n = n + 1
End If
If n > 18 Then Exit Sub
Next
max = max - 1
Loop While max


[/Quote]
楼主想要的是一个字都不用改，拿来就能完全满意使用的代码……您这段代码楼主肯定又会说“不能用”。

[舉杯邀明月]

我的代码只要粘贴到他的窗体代码中，在需要的地方写一句：
（如果你的数组a()是Long的，也要我那个过程的入口参数改成Long）
Call Proc(a)

就可以了，还不行？

真是彻底无语了！

-_-！

[of123]

偏方，利用 ListBox:
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 '在 ListBox 中精确查找

Dim i As Integer, j As Integer
Dim a() As Integer
Dim strTmp1 As String, strTmp2 As String
Dim intTmp1 As Integer, intTmp2 As Integer

For i = 0 To 17
Label1(i).Tag = ""
Next i

'频数统计
List1.Clear
For i = 1 To UBound(a)
j = SendMessagebyString(List1.hWND, LB_FINDSTRINGEXACT, -1, CStr(a(i)))
If j >= 0 Then
List1.ItemData(j) = List1.ItemData(j) + 1
Else
List1.AddItem CStr(a(i))
List1.ItemData(List1.NewIndex) = 1
End If
Next i

'按频数排序显示
For i = 0 To List1.ListCount - 1
strTmp1 = List1.List(i)
intTmp1 = List1.ItemData(i)

For j = 0 To 17
If Label1(j).Tag = "" Then
Label1(j).Caption = strTmp1
Label1(j).Tag = intTmp1
Exit For
ElseIf intTmp1 > Val(Label1(j).Tag) Then
strTmp2 = Label1(j).Caption
intTmp2 = Val(Label1(j).Tag)
Label1(j).Caption = strTmp1
Label1(j).Tag = intTmp1
strTmp1 = strTmp2
intTmp1 = intTmp2
End If
Next j
Next i

[pedkk]

楼上的不好意思　我的a数组类型不一样　给搞错了｀｀
同时也感谢其他朋友的帮助！谢谢！

[波导终结者]

重复的就移除不再比较
重复出现的数值和相应次数可以自己定个Type，再定个动态数组ReDim Preserve

[lsftest]

用直方图方法来记数，再把记下的数后排序（这里要把数组下标跟在一起），输出，收工。
不过如果有条件，用数据库的方法来解决会简单很多。

[舉杯邀明月]

楼主试一下调用这个过程：

Sub Proc(arrSour() As Integer)

    Dim arrTemp%(), arrIndex%(), arrCount&()
    Dim i&, j&, lArrL&, lArrU&
    Dim iTest%, lCount&, lArrPnt&
    
    lArrL = LBound(arrSour)
    lArrU = UBound(arrSour)
    j = lArrU - lArrL
    ReDim arrTemp(lArrL To lArrU), arrIndex(0 To j), arrCount(0 To j)
    For i = lArrL To lArrU
        arrTemp(i) = 1
    Next
    lArrPnt = -1
    For i = lArrL To lArrU - 1
        If (arrTemp(i) = 1) Then
            iTest = arrSour(i)
            lCount = 1
            For j = i + 1 To lArrU
                If (arrSour(j) = iTest) Then
                    lCount = lCount + 1
                    arrTemp(j) = 0
                End If
            Next
            lArrPnt = lArrPnt + 1
            arrIndex(lArrPnt) = iTest
            arrCount(lArrPnt) = lCount
        End If
    Next
    ReDim arrTemp(0 To lArrPnt)
    For i = 0 To lArrPnt: arrTemp(i) = i: Next
    For i = 1 To lArrPnt
        iTest = arrCount(i)
        For lArrL = 0 To i - 1
            If (arrCount(arrTemp(lArrL)) < iTest) Then Exit For
        Next
        For j = i To lArrL + 1 Step -1
            arrTemp(j) = arrTemp(j - 1)
        Next
        arrTemp(lArrL) = i
    Next
    For i = 0 To 17
        j = arrTemp(i)
        label1(i+1).Caption = arrIndex(j) & ">>>>" & arrCount(j)
    Next
    
End Sub