Private Sub Command1_Click() Dim dc As Object, s As String, iMax As Integer, n As Integer Set dc = CreateObject("Scripting.dictionary") Dim i As Integer For i = 1 To Len(Text1.Text) s = Mid(Text1.Text, i, 1) If Not dc.Exists(s) Then dc(s) = 1 Else dc(s) = Val(dc(s)) + 1 If iMax < Val(dc(s)) Then iMax = Val(dc(s)) End If Next s = "" Dim ar ar = dc.keys For i = iMax To 1 Step -1 For n = 0 To UBound(ar) If dc(ar(n)) = i Then s = s & ar(n) & "(" & i & ")" Next Next Text2.Text = sEnd Sub
方法有許多種，給你一個字典的用法，比較方便一些！程式碼如下，詳細可下載附件測試！
Private Sub Command1_Click() Dim dc As Object, s As String, iMax As Integer, n As Integer Set dc = CreateObject("Scripting.dictionary") Dim i As Integer For i = 1 To Len(Text1.Text) s = Mid(Text1.Text, i, 1) If Not dc.Exists(s) Then dc(s) = 1 Else dc(s) = Val(dc(s)) + 1 If iMax < Val(dc(s)) Then iMax = Val(dc(s)) End If Next s = "" Dim ar ar = dc.keys For i = iMax To 1 Step -1 For n = 0 To UBound(ar) If dc(ar(n)) = i Then s = s & ar(n) & "(" & i & ")" Next Next Text2.Text = sEnd Sub