calcul du nombre de chaque mot d'un texte

Le lundi 24 juin 2013 12:18:14 UTC+2, DanielCo a écrit :

Non, ce qui montre de surcroît que tu n'as pas testé la macro. Il

s'agit de remplacer ces caractères afin de ne pas compter à part "nom ,"

et "nom".

Daniel

j'ai ajouté
Dim pos
Dim i
Dim var
la moulinette est partie, mais j'ai un PC au bureau qui rame;
Je vais essayer pas à pas avec avec F8...

Sûr que, si tu as 12000 lignes, ça va prendre du temps.
Daniel

Le lundi 24 juin 2013 12:18:14 UTC+2, DanielCo a écrit :

Non, ce qui montre de surcroît que tu n'as pas testé la macro. Il

s'agit de remplacer ces caractères afin de ne pas compter à part "nom,"

et "nom".

Daniel

j'ai ajouté
Dim pos
Dim i
Dim var
la moulinette est partie, mais j'ai un PC au bureau qui rame;
Je vais essayer pas à pas avec avec F8...

Le lundi 24 juin 2013 12:35:37 UTC+2, DanielCo a écrit :

Sûr que, si tu as 12000 lignes, ça va prendre du temps.

Daniel

Merci , ça a marché avec 800 lignes, sinon ça plante; d'ailleurs ça va me permettre d'appeler le service technique pour qu'ils viennent me cha nger de PC.

Le 24/06/2013 12:15, moi a écrit :

Réponse à GL
Je ne sais pas ce qu'est un regex, je vais chercher

Ce sont les expressions régulières (entre parenthèse, c'est une des
bases de l'informatique...)

Vous commencez par faire :

Private Sub Make_VBS_Ref()
On Error Resume Next 'in case ref already exists
ThisWorkbook.VBProject.References.AddFromGuid _
"{3F4DACA7-160D-11D2-A8E9-00104B365C9F}", 5, 5
On Error GoTo 0
End Sub

Et lancez la procédure : ca ajoute la référence à la bibliothèque regex
de VBScript (vous pouvez le faire par les menus, mais c'est aussi bien
automatiquement)

Ensuite vous pouvez définir une fonction de recherche d'expressions
régulières : je vous donne la mienne (elle est un peu longue parce
que complète ;-) )

C'est :
{= RexExp( <chaîne> ; <ReGeX> )}
=> validation matricielle (extrait toutes les occurences)

ou : = RegExp( <chaîne> ; <ReGeX> ; <n> )
=> Extrait la <n>ième occurence

ou : = RegExp( <chaîne> ; <RegEx> ; <n> ; VRAI )
=> Recherche sensible à la casse
par défault : on ignore la casse : "CaSeS = FAUX"

ou : = RegExp( <chaîne> ; <RegEx> ; <b> ; VRAI|FAUX ; <what> )
avec : <what>
= "match" : extrait l'occurence (par défaut)
= "begin" : index du premier caractère de l'occurence
= "end" : index du dernier caractère de l'occurence
= "length" : nombre de caractères de l'occurence


Par exemple pour extraire tous les mots d'une chaîne de caractères
située en cellule "A1" vous pouvez utiliser en B1 :

{=REGEXP(A1;"bS+b")}

(validation matricielle sur un vecteur-colonne suffisamment grand)

b indique un "word boundary" (limite d'un mot)
S indique un caractère différent des espaces [ nrtvf]

----------------------------------------------------------------
Exemple:
A B
Bonjour les copains. Comment ça va les copains ? {=REGEXP(A1;"bS+b")}


Sur la colonne B vous avez donc la liste de tous les mots.
Il s'agit de la trier pour regrouper sur les doublons :

colonne C
=SIERREUR(SI(EQUIV(B1;B:B;0)=LIGNE();LIGNE());FAUX)

< recopiez vers le bas >

colonne D
{=PETITE.VALEUR(C:C;FORLIST()}

< validation matricielle : tri + élimination des doublons >

colonne E
=INDEX(B:B;D1)
< recopiez vers le bas : mots uniques >

colonne F
= NB.SI(B:B;E1)
< recopiez vers le bas : fréquence des mots >


Bref : le principal problème est bien l'extraction des mots
(dans cet exemple, le texte de départ est entièrement contenu
dans une seule cellule - ça serait plus compliqué sinon)

' -------------------------------------------------------
Public Function RegExp(S, pattern, Optional ItemNmbr% = 0, _
Optional CaSeS As Boolean = False, _
Optional findWhat$ = "Match")
Dim Regex As Object, MatchCollection As Object
Dim str, Patt$
Set Regex = New VBScript_RegExp_55.RegExp
Dim ress() As String, i&

With Regex
.Global = True
.IgnoreCase = Not CaSeS
.MultiLine = True
.pattern = pattern
End With

Set MatchCollection = Regex.Execute(S): Set Regex = Nothing

If MatchCollection.Count = 0 Or _
(ItemNmbr > 0 And MatchCollection.Count < ItemNmbr) Then
RegExp = CVErr(2042): Exit Function
End If

If ItemNmbr < 0 Then RegExp = MatchCollection.Count: Exit Function

Select Case LCase(findWhat)
Case "match"
If ItemNmbr <= 0 Then
ReDim ress(1 To MatchCollection.Count, 1 To 1): i = 1
For i = 1 To MatchCollection.Count
ress(i, 1) = MatchCollection.Item(i - 1)
Next i
RegExp = ress
Else: RegExp = MatchCollection.Item(ItemNmbr - 1)
End If

Case "begin", "start"
If ItemNmbr <= 0 Then
ReDim res(1 To MatchCollection.Count, 1 To 1) As Long
For i = 1 To MatchCollection.Count
res(i, 1) = MatchCollection.Item(i - 1).FirstIndex + 1
Next i
RegExp = res
Else: RegExp = MatchCollection.Item(ItemNmbr - 1).FirstIndex + 1
End If

Case "end"
If ItemNmbr <= 0 Then
ReDim res(1 To MatchCollection.Count, 1 To 1) As Long
For i = 1 To MatchCollection.Count
res(i, 1) = MatchCollection.Item(i - 1).Length + _
MatchCollection.Item(i - 1).FirstIndex
Next
RegExp = res
Else: RegExp = MatchCollection.Item(ItemNmbr - 1).Length + _
MatchCollection.Item(ItemNmbr - 1).FirstIndex
End If

Case "length", "len"
If ItemNmbr <= 0 Then
ReDim res(1 To MatchCollection.Count, 1 To 1) As Long
For i = 1 To MatchCollection.Count
res(i, 1) = MatchCollection.Item(i - 1).Length
Next
RegExp = res
Else: RegExp = MatchCollection.Item(ItemNmbr - 1).Length
End If

Case Else
RegExp = CVErr(2015)
End Select

End Function ' RegExp
' -------------------------------------------------------

Pour info, je vous remet aussi la fonction FORLIST(), dont je ne peux
plus me passer :

' -----------------------------------------------------
Public Function FORLIST(Optional start_value# = 1, _
Optional step_value# = 1)
Dim i&, j&, res() As Double

If Application.Caller.Rows.Count = 1 Then
i = Application.Caller.Columns.Count: ReDim res(1 To 1, 1 To i)
For i = 1 To i
res(1, i) = start_value
start_value = start_value + step_value
Next i
Else: i = Application.Caller.Rows.Count
ReDim res(1 To i, 1 To Application.Caller.Columns.Count)
For i = 1 To i
For j = 1 To UBound(res, 2)
res(i, j) = start_value
Next j
start_value = start_value + step_value
Next i
End If

FORLIST = res

End Function
' --------------------------------------------------------

Ca peut être un problème de mémoire. Même les dernières versions
d'Excel ne gèrent que 2 Go. Si c'est le cas, il faudra modifier la
macro.
Daniel

Le lundi 24 juin 2013 12:35:37 UTC+2, DanielCo a écrit :

Sûr que, si tu as 12000 lignes, ça va prendre du temps.

Daniel

Merci , ça a marché avec 800 lignes, sinon ça plante; d'ailleurs ça va me
permettre d'appeler le service technique pour qu'ils viennent me changer de
PC.

| ça a marché avec 800 lignes, sinon ça plante

Est-ce possible que ce soit cette ligne de code qui plante?
pos = Application.Match(Item, Dico.items, 0)

Sous Excel 2000, la grandeur du tableau (ici -> dico.items)
est limitée, et cela par design. (Par mémoire, je crois qu'Excel
permet un tableau de 6000 entrées...)
Cependant si au lieu d'un tableau, on utilise une plage de cellules,
tu devrais passer outre cette limitation.

Ton problème n'est pas dû à l'âge de ton PC! Tu n'es pas obligé de
tout révéler au service de l'informatique de ta boîte!!! ;-)


MichD
---------------------------------------------------------------

Le lundi 24 juin 2013 14:48:57 UTC+2, MichD a écrit :

| �a a march� avec 800 lignes, sinon �a plante

Non ; puisque ça marche avec 800 lignes

finalement, j'ai scindé le fichier en 5 parties; merci

Le lundi 24 juin 2013 14:48:57 UTC+2, MichD a écrit :

�a a march� avec 800 lignes, sinon �a plante

Non ; puisque ça marche avec 800 lignes

Essaie comme ceci :

Sub Compte2()
Dim Item, Txt As String, C As Range, Pos As Long
Application.ScreenUpdating = False
Sheets(2).[A:B].ClearContents
Tabl = Array("'", "(", ")", ".", ";") 'etc.
For Each Item In Tabl
[A:A].Replace Item, " "
Next Item
With Sheets(1)
For Each C In .Range("A1", .Cells(.Rows.Count, 1).End(xlUp))
Txt = Txt & " " & C.Value
Next C
End With
With Sheets(2)
.[A1] = "Mots"
.[B1] = "Nombres"
Txt = Right(Txt, Len(Txt) - 1)
Tabl = Split(Txt, " ")
For Each Item In Tabl
If Item <> "" Then
If Not IsNumeric(Application.Match(Item, .[A:A], 0))
Then
Set C = .Cells(.Rows.Count, 1).End(xlUp).Offset(1)
C.Value = Item
C.Offset(, 1) = 1
Else
Pos = Application.Match(Item, .[A:A], 0)
.Cells(Pos, 2) = .Cells(Pos, 2) + 1
End If
End If
Next Item
End With
Application.ScreenUpdating = True
' With Sheets(2)
' For i = 0 To Dico.Count - 1
' Ligne = Ligne + 1
' Var = Dico.items
' .Cells(Ligne, 1) = Var(i)
' .Cells(Ligne, 2) = Result(i)
' Next i
' End With
End Sub

Daniel

| 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 Match
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
---------------------------------------------------------------