[已解决]请教各位老师一个运行不匹配的问题

gsrwf

如题，

最佳答案

月排行榜 / 总排行榜

高

2017-10-26 19:56

Sub text()
    Dim d, ar, kr, i&, j&
    Set d = CreateObject("scripting.dictionary")
    [b:c].Clear
    ar = Range("a1", Cells(Rows.Count, 1).End(3))
    For i = 1 To UBound(ar)
        ReDim kr(1 To Len(ar(i, 1)) - 1)
        For j = 1 To Len(ar(i, 1)) - 1
            kr(j) = Mid$(ar(i, 1), j, 1)
        Next
        Call ft(kr)
        ar(i, 1) = Join(kr, "")
        d(ar(i, 1)) = d(ar(i, 1)) + 1
    Next
    Range("b1:c1") = Array("重复", "次数")
    Range("b:b").NumberFormatLocal = "@"
    Range("b2").Resize(d.Count, 2) = Application.Transpose(Array(d.keys, d.items))
    d.RemoveAll: Set d = Nothing
End Sub因为原数据最后一位是空格，所以不用管第四位（空格）

跳转到最佳答案楼层

高

Sub text()
    Dim d, ar, kr, i&, j&
    Set d = CreateObject("scripting.dictionary")
    [b:c].Clear
    ar = Range("a1", Cells(Rows.Count, 1).End(3))
    For i = 1 To UBound(ar)
        ReDim kr(1 To Len(ar(i, 1)) - 1)
        For j = 1 To Len(ar(i, 1)) - 1
            kr(j) = Mid$(ar(i, 1), j, 1)
        Next
        Call ft(kr)
        ar(i, 1) = Join(kr, "")
        d(ar(i, 1)) = d(ar(i, 1)) + 1
    Next
    Range("b1:c1") = Array("重复", "次数")
    Range("b:b").NumberFormatLocal = "@"
    Range("b2").Resize(d.Count, 2) = Application.Transpose(Array(d.keys, d.items))
    d.RemoveAll: Set d = Nothing
End Sub因为原数据最后一位是空格，所以不用管第四位（空格）

gsrwf

高 发表于 2017-10-26 19:56
Sub text()
    Dim d, ar, kr, i&, j&
    Set d = CreateObject("scripting.dictionary")

非常感谢老师的指点，谢谢

gsrwf

高 发表于 2017-10-26 19:56
Sub text()
    Dim d, ar, kr, i&, j&
    Set d = CreateObject("scripting.dictionary")

烦请老师看下这个表是啥问题

高

gsrwf 发表于 2017-11-15 15:09
烦请老师看下这个表是啥问题

有什么问题吗，怎么了

gsrwf

A列刷新数据后，b列显示的号码为何是两位数？