1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38
| Function ListeMotsTab(champ As Range)
exclus = Array("le", "les", "des", "sur", "elle", "est", "ses")
Dim temp()
a = champ
Set mondico = CreateObject("Scripting.Dictionary")
For Each c In a
b = Split(Replace(Replace(Replace(c, ",", " "), "(", " "), ")", " "), " ") 'Split(Replace(c, ",", " "), " ")
For Each K In b
If Len(K) > 2 And Not IsNumeric(K) And IsError(Application.Match(K, exclus, 0)) Then
mondico.Item(LCase(K)) = LCase(K)
End If
Next K
Next c
Dim Tbl()
ReDim Tbl(1 To mondico.Count)
I = 1
For Each c In mondico.items
Tbl(I) = c
I = I + 1
Next
Tri Tbl, LBound(Tbl), mondico.Count
ListeMotsTab = Tbl
End Function
Sub Tri(a(), gauc, droi) ' Quick sort
ref = a((gauc + droi) \ 2)
g = gauc: d = droi
Do
Do While a(g) < ref: g = g + 1: Loop
Do While ref < a(d): d = d - 1: Loop
If g <= d Then
temp = a(g): a(g) = a(d): a(d) = temp
g = g + 1: d = d - 1
End If
Loop While g <= d
If g < droi Then Call Tri(a, g, droi)
If gauc < d Then Call Tri(a, gauc, d)
End Sub |