Erreur programme
Bonjour à tous j'ai un programme qui permet d'afficher les mots qui reviennent le plus parmis mes données, les données sont des commentaires qui se situe sur la feuille "Donnees_brutes" du fichier client dans la colonne D et le résultat est affiché dans la feuille "Analyse" du fichier client dans la colonne i.
Lorsque je lance le programme, ça marche mais ça n'affiche rien, j'ai juste modfié un bout car je veux supprimer des mots qui sont inutile comme "et,a,à,est,etc" pour par perturber la liste de mot sauf qu'il fallait rentrer dans la macro pour le modfiier et mtn j'ai crée une mini base de donnée dans la Colonne A de la feuille "SupprimerMot" du fichier_test sous forme de liste.
Si quelqu'un à la moindre idée je suis preneur
Sub rechercheMots(classeur)
'va stocker tous les mots et les compter
Dim dico As Scripting.Dictionary
Set dico = New Dictionary
'va rechercher les mots
Dim reg As VBScript_RegExp_55.regexp
Dim Match As VBScript_RegExp_55.Match
Dim Matches As VBScript_RegExp_55.MatchCollection
Set reg = New VBScript_RegExp_55.regexp
reg.Pattern = "[a-zA-Zéèâäù']+"
reg.Global = True
Set Matches = reg.Execute(chaine)
For Each Match In Matches
If dico.Exists(LCase(Match)) Then
dico.Item(LCase(Match)) = dico.Item(LCase(Match)) + 1
Else
dico.Add LCase(Match), 1
End If
Next Match
'mots usuels à supprimer
[b]Dim listeMotsSupprimer As Range, rw As Long
With Workbooks("fichier_test").Sheets("SupprimerMot")
rw = .Cells(Rows.Count, 1).End(xlUp).Row
Set listeMotsSupprimer = .Range("A2:A" & rw)
End With[/b] '
For Each element In listeMotsSupprimer
If dico.Exists(LCase(element)) Then
dico.Remove LCase(element)
Next element
Dim tableauTop() As Variant
ReDim tableauTop(1 To 10, 1 To 2)
Dim maxOcc As Integer
Dim numElement As Integer
Dim affichage As String
Dim i As Integer
i = 6
affichage = ""
numElement = 0
maxOcc = 1
While numElement <= 10 And dico.Count > 0 And maxOcc <> 0
maxOcc = 0
numElement = numElement + 1
For Each element In dico.Keys
If dico.Item(element) > maxOcc Then
tableauTop(numElement, 1) = element
tableauTop(numElement, 2) = dico.Item(element)
maxOcc = dico.Item(element)
End If
Next element
If maxOcc > 0 Then
Worksheets("Analyse").Activate
Cells(i, 9) = affichage
Cells(i, 9).Font.Bold = True
Cells(i, 9).Font.ColorIndex = 2
Cells(i, 9).Select
With Selection.Font
.Size = 11
End With
With Cells(8, 7)
.HorizontalAlignment = xlHAlignCenter
End With
i = i + 1
dico.Remove (tableauTop(numElement, 1))
affichage = "N°" & numElement & " : " & tableauTop(numElement, 1) & " (x" & tableauTop(numElement, 2) & ")"
End If
Wend
Set dico = Nothing
End Sub
Sub liste_mots(classeur)
Dim chaine As String
chaine = ""
Workbooks("fichier_client").Activate
Worksheets("Donnees_brutes").Activate
For Each cell In Range("D2").End(xlDown)
chaine = chaine & " " & cell.Value
Next
rechercheMots chaine
End Sub]
Voilà ce que j'ai modifié
Dim listeMotsSupprimer As Range, rw As Long
With Workbooks("fichier_test").Sheets("SupprimerMot")
rw = .Cells(Rows.Count, 1).End(xlUp).Row
Set listeMotsSupprimer = .Range("A2:A" & rw)
End With[
avant il y avait Dim listeMotSupprimer as variante
listeMotSupprimer = Array("a','que",etccc)