Function SujetMotsClés(ByVal Src, Optional ByVal Séparat As String = " ")
Rem. —— Restitue un sujet de mots clés.
' Src: Range ou tableau 2D d'une seule colonne à inventorier.
' Séparat: Groupe de caractères à identifier comme séparateur. Facultatif: un espace assumé.
' Remarque: Certains caractères spéciaux sont remplacés par un espace avant décomposition en mots,
' s'il ne font pas partie de Séparat.
Dim CarEspac As String, N As Long, Te(), Le As Long, Mot As String, TSpl() As String, Ls As Long, _
Mots() As Variant, LgnOrg() As Long, Sujet, LesListes() As Variant, TLgn() As Long, YEnAPas As Boolean
CarEspac = "!""#$%&'()*+,-./:;<=>?@[\]^_`{|}~¡¦§¨«¬®¯»¿"
For N = 1 To Len(Séparat): CarEspac = Replace$(CarEspac, Mid$(Séparat, N, 1), ""): Next N
If TypeName(Src) = "Range" Then Te = Src.Value Else Te = Src
For Le = 1 To UBound(Te)
Mot = Te(Le, 1): For N = 1 To Len(Mot)
If InStr(CarEspac, Mid$(Mot, N, 1)) > 0 Then Mid$(Mot, N, 1) = " "
Next N
TSpl = Split(Mot, Séparat): YEnAPas = True
For N = 0 To UBound(TSpl): Mot = Trim$(TSpl(N))
If Mot <> "" Then
Mid$(Mot, 1, 1) = UCase$(Mid$(Mot, 1, 1)): Ls = Ls + 1: ReDim Preserve Mots(1 To Ls), LgnOrg(1 To Ls)
Mots(Ls) = Mot: LgnOrg(Ls) = Le: YEnAPas = False: End If
Next N
If YEnAPas Then
Ls = Ls + 1: ReDim Preserve Mots(1 To Ls), LgnOrg(1 To Ls)
Mots(Ls) = Empty: LgnOrg(Ls) = Le: End If
Next Le
Sujet = SujetCBx(WorksheetFunction.Transpose(Mots))
LesListes = Sujet(1)
For N = LBound(LesListes) To UBound(LesListes)
TLgn = LesListes(N)
For Ls = LBound(TLgn) To UBound(TLgn): TLgn(Ls) = LgnOrg(TLgn(Ls)): Next Ls
LesListes(N) = TLgn
Next N
SujetMotsClés = Array(Sujet(0), LesListes)
End Function