还是字符串,,钻进去就是出不来了...

[「已注销」]

下面的代码有一些是师傅们给我的,最后一步过不去了
A字符是:“12345678218563679921369926184”
B字符是:"0123456789"

逐个截取B的每位字符，然后查找这个字符在A中出现的次数 并按照出现次数从多到少 排序，我对排序理解不透啊，下面是我的代码。
整个程序是先采集期数的号码，然后分个十百千万，然后查找筛选出固定2个字符在个十百千万中出现的上5位和下5位，这5位不能重复，碰到重复前进1位字符截取再判断是否重复，直到没有字符，这些前5位和后5位，包括不够5位的都采集出来，然后先筛选这些数据的第一个字符，采集8位不同的数，不能相同，相同还是前进一位，如果到最后也不够8位，就判断剩下的数，去掉前面采集的不够8位的数然后合并成一个字符，在这个字符里面查找出现次数最多的数，以从大到小直到凑够8位，还是不能重复，如果还是不够8位，那就，，，算了。。我写的代码在下面，哎，文化程度不够，数学不好，转不过弯来，一晚上才琢磨出来的，现在就差最后一步了，求教师傅们，谢谢了！分不够100了。

Option Explicit

Private Http As WinHttp.WinHttpRequest
Private Sub Command1_Click()
List1.Clear
List7.Clear
Label3.Caption = ""
If Text1.Text <> "" Then
    Dim Str As String, Szfg, i As Integer, Qishu As Integer, haoma As String, ge As String, shi As String, bai As String, qian As String, wan As String
    Dim zuixin As String
    Dim gew, shiw, baiw, qianw, wanw, shua
    Set Http = New WinHttpRequest
    Http.Option(6) = False
    Http.Option(4) = 13056
    Str = GetPage("http://chart.cp.360.cn/zst/getchartdata2?lotId=255401&chartType=x5&spanType=0&span=" & Text1.Text)
    Szfg = Split(Str, "class='tdbg_1' >1")'分割采集数据
    For i = 0 To UBound(Szfg)
        If InStr(1, Szfg(i), "num") > 0 Then
        haoma = Mid(Szfg(i), InStr(1, Szfg(i), "num") + 5, 5)
        End If
        If Mid(Szfg(i), 1, 1) = "7" Then
        List1.AddItem "1" & Mid(Szfg(i), 1, 9) & "--" & haoma
        End If
    Next
    Dim llio
    For llio = 0 To List1.ListCount - 1
        ge = ge & Mid(List1.List(llio), 17, 1)
        shi = shi & Mid(List1.List(llio), 16, 1)
        bai = bai & Mid(List1.List(llio), 15, 1)
        qian = qian & Mid(List1.List(llio), 14, 1)
        wan = wan & Mid(List1.List(llio), 13, 1)
    Next'得到个十百千万的字符并且相连组成一个长字符串
    zuixin = Right(ge, 2)'下面筛选全部依靠这个字符串来的
    Dim olp, ppl, llp, olpa, olpb, olpc, olpd, ZOLPP
    Call JMsj(ge, zuixin)
    Call JMsj(shi, zuixin)
    Call JMsj(bai, zuixin)
    Call JMsj(qian, zuixin)
    Call JMsj(wan, zuixin)'这里不知道为什么用数组会筛选出错就挨个调用的函数
    For ppl = 0 To List7.ListCount
    olp = olp & Mid(List7.List(ppl), 1, 1)
    olpa = olpa & Mid(List7.List(ppl), 2, 1)
    olpb = olpb & Mid(List7.List(ppl), 3, 1)
    olpc = olpc & Mid(List7.List(ppl), 4, 1)
    olpd = olpd & Mid(List7.List(ppl), 5, 1)
    Next
    ZOLPP = olp & olpa & olpb & olpc & olpd'依次截取第一步筛选出的数据在界面列表框中的值并相连组成一个长字符串,为下面_做筛选用
    Dim AAAA, BBBB, CCCC, ksowe
    For ksowe = 1 To Len(olp)
        AAAA = Mid(olp, 1, ksowe)
        BBBB = Mid(olp, ksowe + 1, 1)
        If InStr(1, AAAA, BBBB) < 1 Then
        If Len(CCCC) < 8 Then
        If ksowe = 1 Then
          CCCC = AAAA & BBBB
        Else
          CCCC = CCCC & BBBB
        End If
        End If
        End If
    Next
    Label3.Caption = CCCC'这里是读取列表框每个项的首个字符串，并去掉重复组成8位
    Dim AAStrA, BBStrB, j, iii, KKStrK
    For j = 1 To Len(CCCC)
    AAStrA = Mid(CCCC, j, 1)
    KKStrK = ""
    For iii = 1 To Len(ZOLPP)
        BBStrB = Mid(ZOLPP, iii, 1)
        If BBStrB <> AAStrA Then
           KKStrK = KKStrK & BBStrB
        End If
    Next
    ZOLPP = KKStrK
    Next'这里是把列表框中采集的5位数的总字符串中去掉采集的8位数数据(不够8位也算，就叫8位数数据)
    Dim AAAAA, BBBBB, CCCCC, ksoweA
    For ksoweA = 1 To Len(KKStrK)
    AAAAA = Mid(KKStrK, 1, ksoweA)
    BBBBB = Mid(KKStrK, ksoweA + 1, 1)
    If InStr(1, AAAAA, BBBBB) < 1 Then
       If ksoweA = 1 Then
            CCCCC = AAAAA & BBBBB
       Else
            CCCCC = CCCCC & BBBBB
       End If
    End If
    Next'这里是采集的去掉列表框中采集的8位数后的数据不重复的所有字符并连起来，供下面用
    '这里本应该是判断上面的数据在KKStrK中出现的次数并按照从多到少排序，把不够8位的8位数据补充到8位
  '计算次数的代码我有了，但是不会排序，并补充给8位数据，急啊
End If
End Sub
Function jjjj(TextA, TextB)
strChar = Mid$(strText, i, 1&)
      If (0& = InStr(1&, sA, strChar)) Then
         sA = sA & strChar
         w = 1& + w
         If (5& = w) Then
         List7.AddItem sA
         sA = ""
         w = 0
         End If
      End If
End Function
Public Function GetPage(ByVal URL As String, Optional ByVal PostData As String = "", Optional ByVal UserName As String = "", Optional ByVal Password As String = "") As String
    If Len(PostData) = 0 Then
        Http.Open "GET", URL
        If Len(UserName) > 0 Or Len(Password) > 0 Then Http.SetCredentials UserName, Password, 0
        Http.Send
    Else
        Http.Open "POST", URL
        If Len(UserName) > 0 Or Len(Password) > 0 Then Http.SetCredentials UserName, Password, 0
        Http.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
        Http.SetRequestHeader "Content-Length", LenB(StrConv(PostData, vbFromUnicode))
        Http.Send PostData
    End If
    GetPage = Http.ResponseText
End Function
Public Function JMsj(strText, strSpec)
   Dim strChar As String
   Dim sA$, sE As String
   Dim i&, k&, w  As Long
   k = InStr(1&, strText, strSpec)
   sA = "": w = 0&
   If k > 0 Then
   For i = k - 1& To 1& Step -1&
      strChar = Mid$(strText, i, 1&)
      If (0& = InStr(1&, sA, strChar)) Then
         sA = sA & strChar
         w = 1& + w
         If (5& = w) Then
         List7.AddItem sA
         End If
      End If
   Next
   sA = ""
   w = 0
   sE = "": w = 0&
   For i = 2& + k To Len(strText)
      strChar = Mid$(strText, i, 1&)
      If (0& = InStr(1&, sE, strChar)) Then
         sE = sE & strChar
         w = 1& + w
         If (5& = w) Then
         List7.AddItem sE
         End If
      End If
   Next
   sE = ""
   w = 0
   End If
End Function

[「已注销」]

引用 1 楼 zhao4zhong1 的回复:

剔除重复的功能建议借用Dictionary Items 方法 描述 返回一个包含 Dictionary 对象中所有条目的数组。 语法 object.Items object始终是一个 Dictionary 对象的名字。 说明 下面的代码举例说明了 Items 方法的使用。:

Dim a, d, i             '创建一些变量
Set d = CreateObject("Scripting.Dictionary")
d.Add "a", "Athens"     '添加一些关键字和条目。
d.Add "b", "Belgrade"
d.Add "c", "Cairo"
a = d.Items             '取得条目
For i = 0 To d.Count -1 '重复数组
    Print a(i)          '打印条目
Next
...

。。。我试试，那要是数组按从大到小排序该怎么做啊赵四老师

[「已注销」]

我在按键精灵写的查找出现次数，但是放在VB种数组超过下标，为什么VB就不能这样用？

Dim StrA="1233455668789945110878777771234567890"
Dim StrB="0123456789"
Dim ArrayStr=array()
Dim 次数=0
For a = 1 To Len(StrB) + 1
    Dim StrC=Mid(StrB,a,1)
    For b = 1 To Len(StrA)
    	Dim StrD=Mid(StrA,b,1)
    	If StrD = StrC Then
    		次数 = 次数 + 1
    	End If
    Next
    ArrayStr(a) = StrC & "的次数是:" & 次数
    次数 = 0
Next
For c = 1 To UBOUND(ArrayStr) - 1
TracePrint ArrayStr(c)
Next

[赵4老师]

Private Sub Command1_Click()
Dim StrA As String
Dim StrB As String
Dim i As Long
Dim j As Long
Dim Cnt() As Long
Dim C() As String
Dim t As Long
Dim s As String

    StrA = "1233455668789945110878777771234567890"
    StrB = "0123456789"
    ReDim Cnt(Len(StrB) + 1)
    ReDim C(Len(StrB) + 1)
    For i = 1 To Len(StrB)
        C(i) = Mid(StrB, i, 1) '逐个截取B的每位字符，
        '然后查找这个字符在A中出现的次数
        Cnt(i) = 0
        For j = 1 To Len(StrA)
            If Mid(StrA, j, 1) = C(i) Then Cnt(i) = Cnt(i) + 1
        Next
    Next
    '按照出现次数从多到少排序
    For i = 1 To Len(StrB) - 1
        For j = i + 1 To Len(StrB)
            If Cnt(i) < Cnt(j) Then
                t = Cnt(i): Cnt(i) = Cnt(j): Cnt(j) = t
                s = C(i): C(i) = C(j): C(j) = s
            End If
        Next
    Next
    For i = 1 To Len(StrB)
        Debug.Print C(i); "出现"; Cnt(i); "次"
    Next
End Sub
'7出现 8 次
'8出现 5 次
'1出现 4 次
'5出现 4 次
'6出现 3 次
'4出现 3 次
'3出现 3 次
'9出现 3 次
'2出现 2 次
'0出现 2 次

[of123]

奇葩解法：

Private Sub Command1_Click()
Dim StrA As String
Dim StrB As String
Dim i As Long
Dim tmp1 As String, tmp2 As String
Dim n1 As Long
Dim n2 As Long
StrA = "1233455668789945110878777771234567890"
StrB = "0123456789"

'set List1.Sorted = True
n1 = Len(StrA)
For i = 1 To Len(StrB)
    tmp1 = Mid(StrB, i, 1)
    tmp2 = Replace(StrA, tmp1, "")
    
    n2 = n1 - Len(tmp2)
    
    List1.AddItem n2
    List1.ItemData(List1.NewIndex) = Asc(tmp1)
Next i

For i = List1.ListCount - 1 To 0 Step -1
    Debug.Print Chr(List1.ItemData(i)) & ": " & List1.List(i)
Next i

End Sub

7: 8
8: 5
1: 4
5: 4
3: 3
9: 3
4: 3
6: 3
0: 2
2: 2

[赵4老师]

剔除重复的功能建议借用Dictionary Items 方法 描述 返回一个包含 Dictionary 对象中所有条目的数组。 语法 object.Items object始终是一个 Dictionary 对象的名字。 说明 下面的代码举例说明了 Items 方法的使用。:

Dim a, d, i             '创建一些变量
Set d = CreateObject("Scripting.Dictionary")
d.Add "a", "Athens"     '添加一些关键字和条目。
d.Add "b", "Belgrade"
d.Add "c", "Cairo"
a = d.Items             '取得条目
For i = 0 To d.Count -1 '重复数组
    Print a(i)          '打印条目
Next
...