[已解决]提取重复出现文字多到少排序

雨夜1987

如图

最佳答案

月排行榜 / 总排行榜

grf1973

2016-4-13 09:25

............

跳转到最佳答案楼层

grf1973

1. Sub tt()
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     arr = [a1].CurrentRegion
   
4.     For i = 2 To UBound(arr)
   
5.         x = arr(i, 1): L = Len(x)
   
6.         For k = 1 To L
   
7.             y = Mid(x, k, 1)
   
8.             d(y) = d(y) + 1
   
9.         Next
   
10.         ReDim brr(L)
    
11.         For Each y In d.keys
    
12.             p = d(y)
    
13.             brr(L - p) = brr(L - p) & y
    
14.         Next
    
15.         arr(i, 2) = Join(brr, "")
    
16.     Next
    
17.     [a1].CurrentRegion = arr
    
18. End Sub
    

复制代码

grf1973

16句前加个d.removeall

雨夜1987

grf1973 发表于 2016-4-12 16:48

非常感谢！如果A列有很多文字呢，比如A1到A1000都有数据，如何在B列对应提取出来呢？

上清宫主

Sub test()
Dim a()
st1$ = [a2]
i% = Len(st1)
ReDim a(1 To i)
Do While Len(st1)
   st2$ = Left(st1, 1)
   a(i - Len(st1) + Len(Replace(st1, st2, ""))) = a(i - Len(st1) + Len(Replace(st1, st2, ""))) & st2
   st1 = Replace(st1, st2, "")
Loop
[a3] = Join(a, "")
End Sub

pengyx

Function pengyx(ss As String)'用法“=pengyx(a1)”
Set d = CreateObject("scripting.dictionary")
a = Len(ss)
ReDim ar(1 To a, 1 To 2)
For i = 1 To a
    t = Mid(ss, i, 1)
    r = d(t)
    If r = "" Then
        s = s + 1
        d(t) = s
        ar(s, 1) = t
        ar(s, 2) = 1
    Else
        ar(r, 2) = ar(r, 2) + 1
    End If
Next
    For j = 1 To s
        For k = j + 1 To s - 1
            If ar(k, 2) > ar(j, 2) Then
                x1 = ar(k, 1): x2 = ar(k, 2)
                ar(k, 1) = ar(j, 1): ar(k, 2) = ar(j, 2)
                ar(j, 1) = x1: ar(j, 2) = x2
            End If
        Next
    tt = tt & ar(j, 1)
    Next
pengyx = tt
End Function

雨夜1987

pengyx 发表于 2016-4-12 17:23
Function pengyx(ss As String)'用法“=pengyx(a1)”
Set d = CreateObject("scripting.dictionary")
a = ...

你好，这个怎么用？可以给一个附件吗？

雨夜1987

上清宫主 发表于 2016-4-12 17:01
Sub test()
Dim a()
st1$ = [a2]

你好，这个怎么用？可以给一个附件吗？

dsfada

学习了！！

grf1973

雨夜1987 发表于 2016-4-12 16:54
非常感谢！如果A列有很多文字呢，比如A1到A1000都有数据，如何在B列对应提取出来呢？

直接用即可