Dictionary & utilisation de "instr"

elgringo123456

XLDnaute Occasionnel
Supporter XLD
Bonjour,

Cela faisait un moment que je ne m'étais pas poser de questions sur Excel. Et cette fois-ci après de multiples recherches sur le net, j'arrive à la question suivante : utilisation de l'object Dictionary et d'une fonction ressemblant à Instr mais adapté à l'univers des dictionnaires.

Bibliothèque utilisé : Microsoft Scripting Runtime => Contenant la classe Dictionary, la méthode Exists est utile
1. En effet après chargement du dictionnaire
2. Utilisation de la méthode Exist
va très très vite mais il faut comparer 2 éléments totalements ressemblant

Je souhaiterais continuer d'utiliser la bibliotheque Dictionary ou une autre mais cette fois-ci me permettant d'utiliser la fonction Instr mais dédié à de grosses requêtes

Exemple concret en pièce jointe
En d'autre termes je vais avoir beaucoup beaucoup de phrases (100k) et je souhaiterais savoir pour chacune des phrases elle contient le motif "mot" (et pour info je vais avoir beaucoup de mots (10k)

En réalisant des doubles boucles sous Excel c'est dure dure en calcul d'ou l'intérêt de passer en dico avec la méthode Exists mais cette méthode ne fonctionne pas avec une recherche de motifs

Auriez-vous une solution ou des idées de recherches pour boucler 100k éléments avec au moins 10k élémenrts voir plus et le tout réaliser une recherche par motif ?

De mon côté je n'ai pas trouvé la solution.
Merci d'avance de vos remarques,
Cordialement
elgringo123456
 

Pièces jointes

  • Exemple concret.xlsm
    14.5 KB · Affichages: 44

PMO2

XLDnaute Accro
Re : Dictionary & utilisation de "instr"

Bonjour,

Essayez
Code:
Sub General()
    Dim DicoMots As New Dictionary
    Dim i As Long
    Dim j As Long
    Dim A$
    
    For i = 2 To 4
        DicoMots.Add Format(LCase(Trim(Cells(i, 3)))), 1
    Next i
    
    For i = 2 To 6
      For j = 0 To DicoMots.Count - 1
        A$ = DicoMots.Keys(j)
        If InStr(1, (Format(LCase(Trim(Cells(i, 1))))), A$) Then
            MsgBox "Trouvé : " & LCase(Trim(Cells(i, 1)))
        End If
      Next j
    Next i

End Sub
 

BOISGONTIER

XLDnaute Barbatruc
Repose en paix
Re : Dictionary & utilisation de "instr"

Bonsoir,

La seule chose que l'on puisse faire pour optimiser:

-Mettre les mots dans un dico.
-Découper chaque phrase dans un tableau a() avec Split().
-Pour chaque item du tableau a(), vérifier sa présence dans le dico des mots avec Exists() (très rapide).

Pour 100.000 phrases de 10 mots: 100.0000 x 10 tests.

--->PMO2

Dans ton pgm,le dico n'apporte rien par rapport à un tableau classique.

100.0000 x 10.000 tests

JB
 
Dernière édition:

Dranreb

XLDnaute Barbatruc
Re : Dictionary & utilisation de "instr"

Bonjour.

J'ai une fonction qui renvoie un dictionnaires arborescent de mot clés construit à partir des phrases, si ça vous intéresse. Mais "cuis" n'en ferait pas partie: ce n'est pas un mot dans vos exemples de phrases. Mais si les Keys du Dictionary étaient affectées au List d'un ComboBox, il suffirait de taper "c" pour tomber sur "cuisine" qui y figurerait entre "beau" et "fait" dans la liste (les clé de mes dictionnaires arborescents sont toujours classées).
 
Dernière édition:

Staple1600

XLDnaute Barbatruc
Re : Dictionary & utilisation de "instr"

Bonjour à tous

Auriez-vous une solution ou des idées de recherches pour boucler 100k éléments avec au moins 10k élémenrts voir plus et le tout réaliser une recherche par motif ?

De mon côté je n'ai pas trouvé la solution.
Merci d'avance de vos remarques,
Suggestions (en guise de remarque ;)
Peut-être une piste à creuser
Sans oublier l'emploi des expressions régulières
Par contre mixer tout ceci dans VBA risque d'être coton.
 

mapomme

XLDnaute Barbatruc
Supporter XLD
Re : Dictionary & utilisation de "instr"

Bonjour à tous,

Un essai avec des "dictionary" :D mais pas de Instr :(.


  • les comparaisons ne tiennent pas compte de la casse (on peut changer cela par la propriété CompareMode des dictionary)
  • pour environ 15 000 phrases et 350 mots ou groupes de lettres, ma vieille bécane met 28 sec. pour l'exécution
  • je n'ai pas pour l'instant pas trouvé d'autre idée de méthode pour aller plus vite
  • je vous laisse calculer pour 100 000 phrases et 10 000 mots ou groupes de lettres !
  • un rapide calcul, sans doute faux, me conduit à estimer une durée entre 1h40 et 2h00 au mieux
  • attention: pour de telles valeurs (100 000 & 10 000), l'utilisation de tableaux et dico pourraient dépasser les capacités de la mémoire. Dans ce cas, il faudrait rajouter une boucle pour traiter les phrases par paquets plus petits afin de réduire la mémoire utilisée par les variables dicoPhrases et Tablo


Le code:
VB:
Sub MotsDansPhrase()
Dim dicoMots, dicoPhrases, derMot&, derPhrase&
Dim tablo, tailMin&, tailmax, aux
Dim elem, i&, t0, Nelem&

  ' effacement des précédents résultats
   Range("b2:b" & Rows.Count).ClearContents
  t0 = Timer
  ' remplissage de dicoMots
  derMot& = Range("c" & Rows.Count).End(xlUp).Row
  tablo = Range("c2:c" & derMot&).Value
  Set dicoMots = CreateObject("scripting.dictionary")
  dicoMots.CompareMode = vbTextCompare     'vbBinaryCompare
  tailMin = 99999
  For Each elem In tablo
    ' ajouter au dico
    dicoMots(CStr(elem)) = Empty
    ' Longueur Max et min des éléments de la liste des mots à chercher
    If Len(elem) < tailMin Then tailMin = Len(elem)
    If Len(elem) > tailmax Then tailmax = Len(elem)
  Next elem

  ' boucle sur chaque phrase
  derPhrase = Range("a" & Rows.Count).End(xlUp).Row
  tablo = Range("a2:a" & derPhrase).Value
  
  For i = 1 To derPhrase - 1
    ' remplissage de dicoPhrases
    sousListe tablo(i, 1), tailMin, tailmax, aux, Nelem
    tablo(i, 1) = Empty
    If Nelem > 0 Then
      Set dicoPhrases = CreateObject("scripting.dictionary")
      dicoPhrases.CompareMode = vbTextCompare      'vbBinaryCompare
      For Each elem In aux: dicoPhrases(elem) = Empty: Next elem
      ' boucle de recherche
      For Each elem In dicoPhrases
        If dicoMots.Exists(elem) Then
          tablo(i, 1) = elem
          Exit For
        End If
      Next elem
    End If
  Next i
  Range("b2").Resize(derPhrase - 1) = tablo
  MsgBox "Terminé -> " & Format(Timer - t0, " #,##0") & " sec."
End Sub

Sub sousListe(X, xmin, xmax, yRes, yN)
' découpe la phrase en autant de string de longueur L que possible
' L parcourt l'intervalle xmin à bsup (qui est le max de len(X) et de xmax)
' on renvoie un tableau yRes avec tous ces string
' on renvoie aussi yN qui est le nombre de string

Dim tablo(), i&, j&, m&, ncar&, bsup&
  
  ncar = Len(X)
  If xmax <= Len(X) Then bsup = xmax Else bsup = Len(X)
  For i = xmin To bsup
    For j = 1 To ncar - i + 1
      m = m + 1
      ReDim Preserve tablo(1 To m)
      tablo(m) = Mid(X, j, i)
    Next j
  Next i
  yRes = tablo: yN = m
End Sub
 

Pièces jointes

  • elgringo123456-Exemple concret-v01.xlsm
    260 KB · Affichages: 40
Dernière édition:

BOISGONTIER

XLDnaute Barbatruc
Repose en paix
Re : Dictionary & utilisation de "instr"

Bonjour,

Recherche sur mots entiers: 3 sec

Code:
Sub rechercheMotEntiers()
 Set d = CreateObject("Scripting.Dictionary")
 For Each c In [C2:C356]: d(c.Value) = "": Next c
 a = [a2:a15000].Value
 For i = LBound(a) To UBound(a)
    b = Split(Replace(a(i, 1), "'", " "), " ")
   For j = LBound(b) To UBound(b)
     If d.Exists(b(j)) Then Cells(i + 1, 2) = b(j)
   Next j
 Next i
End Sub

http://boisgontierjacques.free.fr/fichiers/Cellules/DicoPhrasesMots.xls

JB
 

Pièces jointes

  • elgringo123456-Exemple concret-v01.xls
    911.5 KB · Affichages: 53
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
312 490
Messages
2 088 879
Membres
103 981
dernier inscrit
vinsalcatraz