Logo GNT
Actualités Tests & Guides Bons Plans
GTA 6 iPhone 17 Copilot Switch 2 Temu ChatGPT Tesla
OVH Cloud OVH Cloud
Entraide Applications Microsoft Office Excel calcul du nombre de chaque mot d'un texte
Erreur

Le sujet spécifié n'existe pas

calcul du nombre de chaque mot d'un texte

51 réponses
Avatar
eric.zzzz
Bonjour,
Comment calculer le nombre de chaque mot d'un texte (en word ou en pdf que =
je pourrais copier dans excel si n=E9cessaire)
Merci d'avance
Signaler un problème avec ce contenu

10 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
1 2 3 4 5
Avatar
moi
Le mardi 25 juin 2013 17:21:50 UTC+2, MichD a écrit :
| Non ; puisque ça marche avec 800 lignes



Ce n'est pas une question de lignes!



Quand tu définis une variable comme étant un tableau

Exemple : Dim MyVar()



Par désign, le paramètre 2 de la fonction "Match" ne peut pas

fonctionner si la variable "MyVar()" contient plus que 5000 et 6000

entrées pour la version Excel 2000. Cela s'est accru avec les versions

suivantes, mais je ne peux pas te donner la limite pour chacune des

versions.



Exemple :



x = Application.Match(V, MyVar,0)



Cela est problématique si la valeur recherchée est par exemple

le 7001 entrée dans le tableau MyVar.





Si tu veux connaître le nombre d'éléments limites de la fonction Ma tch

de ta version Excel, tu peux exécuter cette macro une fois.

(Cette procédure n'est pas très rapide à l'exécution...)



'-----------------------------------

Sub test()

Dim GestionErreur As String

Dim A As Long, x As Long, MyVar()

On Error Resume Next

For A = 1 To Rows.Count

ReDim Preserve MyVar(1 To A)

MyVar(A) = A

DoEvents

x = Application.Match(A, MyVar, 0)

On Error GoTo GestionErreur

Next

MsgBox "Aucune limite trouvée à la fonction ""Match""."

Exit Sub

GestionErreur:

Err.Clear

MsgBox "Dernière valeur traitée par la procédure est : " & A -1 & " ."

End Sub

'-----------------------------------



Pour Excel 2010, fonction s'arrête de retourner la valeur au-delà de

la position dans la variable "Tableau" MyVar est de : 65536. Cela est

bien en deçà du nombre de lignes dans une feuille du classeur 2010.





MichD

---------------------------------------------------------------



J'ai arrêté la subtest à 25000
Il s'est planté à la ligne 2434 du fichier
sur la ligne de code : .Cells(Pos, 2) = .Cells(Pos, 2) + 1

Erreur d'exécution 13, incompatibilité de type
Faut-il changer le Pos As Long ?
Avatar
DanielCo

J'ai arrêté la subtest à 25000
Il s'est planté à la ligne 2434 du fichier
sur la ligne de code : .Cells(Pos, 2) = .Cells(Pos, 2) + 1

Erreur d'exécution 13, incompatibilité de type
Faut-il changer le Pos As Long ?



A mon avis, Excel est à court de mémoire. Utilise plutôt la macro de
mon post de 15:41:05.
Daniel
Avatar
moi
"DanielCo" a écrit dans le message de news:
kqcrpb$et5$
>
J'ai arrêté la subtest à 25000
Il s'est planté à la ligne 2434 du fichier
sur la ligne de code : .Cells(Pos, 2) = .Cells(Pos, 2) + 1

Erreur d'exécution 13, incompatibilité de type Faut-il changer le Pos As
Long ?



A mon avis, Excel est à court de mémoire. Utilise plutôt la macro de mon
post de 15:41:05.
Daniel



Il y a un malentendu, j'ai justement testé la macro de 15:41
celle d'hier ramait , j'ai attendu un bon moment et j'ai abandonné



--- news://freenews.netfront.net/ - complaints: ---
Avatar
DanielCo
Sûr que c'est beaucoup plus long. J'ai repris la première version en
scindant le traitement par paquets de 100 lignes. Si c'est encore trop,
on pourra diminuer :

Sub Compte()
Dim Tabl, Item, Txt As String, C As Range, Ligne As Long, Ctr, Dico
As Object
Dim Result() As Long
Application.ScreenUpdating = False
Sheets(2).[A:B].ClearContents
Tabl = Array("'", "(", ")", ".", ";") 'etc.
For Each Item In Tabl
[A:A].Replace Item, " "
Next Item
Set Dico = CreateObject("Scripting.Dictionary")
For i = 1 To Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row Step 100
With Sheets(1)
Txt = ""
Dico.RemoveAll
ReDim Result(0)
Ctr = -1
For Each C In .Range(.Cells(i, 1), .Cells(i + 99,
1).End(xlUp))
Txt = Txt & " " & C.Value
Next C
Txt = Right(Txt, Len(Txt) - 1)
Tabl = Split(Txt, " ")
For Each Item In Tabl
If Item <> "" Then
If Not Dico.exists(Item) Then
Dico.Add Item, Item
Ctr = Ctr + 1
ReDim Preserve Result(Ctr)
Result(Ctr) = Result(Ctr) + 1
Else
Pos = Application.Match(Item, Dico.items, 0)
Result(Pos - 1) = Result(Pos - 1) + 1
End If
End If
Next Item
End With
With Sheets(2)
For x = 0 To Dico.Count - 1
Ligne = .Cells(Rows.Count, 1).End(xlUp).Row + 1
Var = Dico.items
If Not IsNumeric(Application.Match(Var(x), .[A:A], 0))
Then
.Cells(Ligne, 1) = Var(x)
.Cells(Ligne, 2) = Result(x)
Else
Ligne = Application.Match(Var(x), .[A:A], 0)
.Cells(Ligne, 2) = .Cells(Ligne, 2) + 1
End If
Next x
End With
Next i
Application.ScreenUpdating = True
End Sub


Daniel


"DanielCo" a écrit dans le message de news:
kqcrpb$et5$
>
J'ai arrêté la subtest à 25000
Il s'est planté à la ligne 2434 du fichier
sur la ligne de code : .Cells(Pos, 2) = .Cells(Pos, 2) + 1

Erreur d'exécution 13, incompatibilité de type Faut-il changer le Pos As
Long ?



A mon avis, Excel est à court de mémoire. Utilise plutôt la macro de mon
post de 15:41:05.
Daniel



Il y a un malentendu, j'ai justement testé la macro de 15:41
celle d'hier ramait , j'ai attendu un bon moment et j'ai abandonné



--- news://freenews.netfront.net/ - complaints: ---
Avatar
GL
Le 26/06/2013 11:05, DanielCo a écrit :
Sûr que c'est beaucoup plus long. J'ai repris la première version en
scindant le traitement par paquets de 100 lignes. Si c'est encore trop,
on pourra diminuer :



A priori, c'est le ReDim Preserve qui va manger beaucoup de temps
en cas de boucle longue : chaque ReDim Preserve va réallouer de la
mémoire et aussi recopier les données dans la nouvelle plage de mémoire
(équivalent de c "realloc")

En principe, comme en c :
- soit on alloue un tableau d'une taille suffisamment grande dès le
départ. Pendant la boucle, il n'y a pas d'allocation. En fin de
boucle, on réalloue à une taille inférieure (ce qui n'est fait
qu'une seule fois donc, et en plus ne nécessite pas la recopie
des données, donc très rapide).

- soit on ne sait vraiment pas choisir une borne sup pour la taille
du tableau, et dans ce cas on alloue dynamiquement en progression
géométrique :

1ere allocation : MemSize = 1000 par exemple
ReDim Result(MemSize)
puis : Si Ctr >MemSize
MemSize = 2 * MemSize
ReDim Preserve Result(MemSize)
Ainsi le nombre de réallocation est en
log_2(nombre total des données)

Et à la fin : ReDim Preserve Result (<Taille finale>)
avec Taille Finale < la valeur courante de MemSize

C'est la méthode générale d'allocation dynamique d'un buffer
de taille inconnue.

Cdt.


Sub Compte()
Dim Tabl, Item, Txt As String, C As Range, Ligne As Long, Ctr, Dico
As Object
Dim Result() As Long
Application.ScreenUpdating = False
Sheets(2).[A:B].ClearContents
Tabl = Array("'", "(", ")", ".", ";") 'etc.
For Each Item In Tabl
[A:A].Replace Item, " "
Next Item
Set Dico = CreateObject("Scripting.Dictionary")
For i = 1 To Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row Step 100
With Sheets(1)
Txt = ""
Dico.RemoveAll
ReDim Result(0)
Ctr = -1
For Each C In .Range(.Cells(i, 1), .Cells(i + 99, 1).End(xlUp))
Txt = Txt & " " & C.Value
Next C
Txt = Right(Txt, Len(Txt) - 1)
Tabl = Split(Txt, " ")
For Each Item In Tabl
If Item <> "" Then
If Not Dico.exists(Item) Then
Dico.Add Item, Item
Ctr = Ctr + 1
ReDim Preserve Result(Ctr)
Result(Ctr) = Result(Ctr) + 1
Else
Pos = Application.Match(Item, Dico.items, 0)
Result(Pos - 1) = Result(Pos - 1) + 1
End If
End If
Next Item
End With
With Sheets(2)
For x = 0 To Dico.Count - 1
Ligne = .Cells(Rows.Count, 1).End(xlUp).Row + 1
Var = Dico.items
If Not IsNumeric(Application.Match(Var(x), .[A:A], 0)) Then
.Cells(Ligne, 1) = Var(x)
.Cells(Ligne, 2) = Result(x)
Else
Ligne = Application.Match(Var(x), .[A:A], 0)
.Cells(Ligne, 2) = .Cells(Ligne, 2) + 1
End If
Next x
End With
Next i
Application.ScreenUpdating = True
End Sub


Daniel


"DanielCo" a écrit dans le message de news:
kqcrpb$et5$
>
J'ai arrêté la subtest à 25000
Il s'est planté à la ligne 2434 du fichier
sur la ligne de code : .Cells(Pos, 2) = .Cells(Pos, 2) + 1

Erreur d'exécution 13, incompatibilité de type Faut-il changer le
Pos As Long ?



A mon avis, Excel est à court de mémoire. Utilise plutôt la macro de
mon post de 15:41:05.
Daniel



Il y a un malentendu, j'ai justement testé la macro de 15:41
celle d'hier ramait , j'ai attendu un bon moment et j'ai abandonné



--- news://freenews.netfront.net/ - complaints: ---




Avatar
DanielCo
Intéressant, je ferais un essai. Pour le moment, ce n'est pas une
question de temps mais de mémoire.
Daniel
A priori, c'est le ReDim Preserve qui va manger beaucoup de temps
en cas de boucle longue : chaque ReDim Preserve va réallouer de la
mémoire et aussi recopier les données dans la nouvelle plage de mémoire
(équivalent de c "realloc")
Avatar
moi
Le mercredi 26 juin 2013 11:54:07 UTC+2, DanielCo a écrit :
Intéressant, je ferais un essai. Pour le moment, ce n'est pas une

question de temps mais de mémoire.

Daniel




j'ai attendu plus d'un quart d'heure et j'ai arrêté.

Pour hier soir, je précise que le code s'est planté sur la ligne de cod e : .Cells(Pos, 2) = .Cells(Pos, 2) + 1
msg = erreur 13
et qu'il a saisi 2434 mots avec leur nombre dans le Feuil2
Avatar
DanielCo
j'ai attendu plus d'un quart d'heure et j'ai arrêté.

Pour hier soir, je précise que le code s'est planté sur la ligne de code :
.Cells(Pos, 2) = .Cells(Pos, 2) + 1 msg = erreur 13
et qu'il a saisi 2434 mots avec leur nombre dans le Feuil2



Pourquoi ? Tu étais pressé ? Quand tu traites une telle masse de
données, le résultat ne peut pas être instantané. Est-ce que ton texte
est confidentiel ou est-ce que tu peux le mettre sur cjoint.com ou
autre ? En le compactant au besoin.
Daniel
Avatar
DanielCo
Je viens d'avoir une erreur semblable. Dans mon cas, c'est un signe "="
qui provoque l'erreur. Il faut donc l'ajouter dans la liste des
caractères à éliminer.
Daniel


Le mercredi 26 juin 2013 11:54:07 UTC+2, DanielCo a écrit :
Intéressant, je ferais un essai. Pour le moment, ce n'est pas une

question de temps mais de mémoire.

Daniel




j'ai attendu plus d'un quart d'heure et j'ai arrêté.

Pour hier soir, je précise que le code s'est planté sur la ligne de code :
.Cells(Pos, 2) = .Cells(Pos, 2) + 1 msg = erreur 13
et qu'il a saisi 2434 mots avec leur nombre dans le Feuil2
Avatar
DanielCo
j'ai attendu plus d'un quart d'heure et j'ai arrêté.

Pour hier soir, je précise que le code s'est planté sur la ligne de code :
.Cells(Pos, 2) = .Cells(Pos, 2) + 1 msg = erreur 13
et qu'il a saisi 2434 mots avec leur nombre dans le Feuil2



Je viens de faire un essai sur 13700 lignes. La macro a pris 10 mn 11
sec. Ca dépend évidemment plus du nombre de mot que du nombre de
lignes. Du processeur aussi. J'ai corrigé le décompte qui était faux
parfois. Je vais essayer avec ce qu' a dit GL. Voici le code modifié :

Sub Compte()
Dim Tabl, Item, Txt As String, C As Range, Ligne As Long, Ctr, Dico
As Object
Dim Result() As Long
deb = Timer
Application.ScreenUpdating = False
Sheets(2).[A:B].ClearContents
Tabl = Array("'", "(", ")", ".", ";", "=") 'etc.
For Each Item In Tabl
[A:A].Replace Item, " "
Next Item
Set Dico = CreateObject("Scripting.Dictionary")
For i = 1 To Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row Step 100
With Sheets(1)
Txt = ""
Dico.RemoveAll
ReDim Result(0)
Ctr = -1
For Each C In .Range(.Cells(i, 1), .Cells(i + 99,
1).End(xlUp))
Txt = Txt & " " & C.Value
Next C
Txt = Right(Txt, Len(Txt) - 1)
Tabl = Split(Txt, " ")
For Each Item In Tabl
If Item <> "" Then
If Not Dico.exists(Item) Then
Dico.Add Item, Item
Ctr = Ctr + 1
ReDim Preserve Result(Ctr)
Result(Ctr) = Result(Ctr) + 1
Else
Pos = Application.Match(Item, Dico.items, 0)
Result(Pos - 1) = Result(Pos - 1) + 1
End If
End If
Next Item
End With
With Sheets(2)
For x = 0 To Dico.Count - 1
Ligne = .Cells(Rows.Count, 1).End(xlUp).Row + 1
Var = Dico.items
If Not IsNumeric(Application.Match(Var(x), .[A:A], 0))
Then
Var1 = Var(x)
.Cells(Ligne, 1).Value = Var(x)
.Cells(Ligne, 2) = Result(x)
Else
Ligne = Application.Match(Var(x), .[A:A], 0)
.Cells(Ligne, 2) = .Cells(Ligne, 2) + Result(x)
End If
Next x
End With
Next i
MsgBox Timer - deb
Application.ScreenUpdating = True
End Sub

Daniel
1 2 3 4 5