XL 2016 rechercher un mot dans une base

Grand merci à toi.

Bonsoir patricktoulon, sousou, BOISGONTIER, dindin, Le forum

Procédure, Via module de Classe et Expression Régulière (Regex).

Fichier ci-joint avec code VBA : Option Microsoft VBScript Regular Expressions coché

j'ai 2 onglet :
- Base = OK
- résultat = OK
le premier contient les colonnes B à F = OK
en A1 le mot à rechercher dans base (colonnes B à F) = OK

Si vous avez aimez mon code, donner moi un j'aime ;-))

Laurent950

bonsoir laurent 950
je salut le travail de présentation cependant je pense que barre de progression et compagnie c'est un peu to mutch sachant que c'est déja suffisamment long et le regex ici n'a pas sa place sachant que l'expression recherchée est bien clarifiée et ne comporte qu'un seul mot
mais je trouve vraiment ta présentation très bien
et pour une utilisation sur multi pc opte pour le late binding hoistoire de ne pas avoir a activer la ref ou la modifier (en effet elle est différente selon les versions windows

Bonsoir PartickToulon,
je connais pas se terme : late binding
c'est une liaison tardive ?
Donc pas besoin de coché sur la machine : Option Microsoft VBScript Regular Expressions

Qu'elle est le Type d'Objet
Ps : Avec cette option quand on tape par exemple reg. (Il n'y a pas après le point les méthode et propriété de la classe par Default quand j'utilise Objet), je l'utilise mal certainement ?

Juste :
Private reg As Object
Private Match As Object
Private Matches As Object

Set reg = CreateObject("VBScript.RegExp") '

Cela correspond au late binding ? : https://mhubiche.developpez.com/vba/fiches/comprendre/binding/

Je suis curieux d'apprendre, si il y a un cours ou Tuto ou que vous avez la réponse pour que je puisse l'adapter à un autres de mes codes ou j'utilise votre méthode mais que j'ai pas les bibliothèques par Default après le point.

Regex : Memo

Au plaisir de vous lire et d'apprendre à mon tour, se soir il est tard mais demain je vais étudier cela.

un grand merci a vous PatrickToulon


Laurent

re

Ps : Avec cette option quand on tape par exemple reg. (Il n'y a pas après le point les méthode et propriété de la classe par Default quand j'utilise Objet), je l'utilise mal certainement ?

Cliquez pour agrandir...

oui en effet en late binding nous n'avons pas l'auto complétion dans et pendant l’édition du code

c'est vrai que pendant l’élaboration du code utiliser le early binding (avec référence cochées) et "as new ...." c'est mieux
mais pour la distribution les remettre en late binding

mais entre nous je le redis utiliser un regex pour chercher un mot bien défini c'est prendre un tank pour aller chercher sa baguette au boulanger
les match te donneront toujours le même mots
même si j'aime bien faire mumuse avec cet object
un regex sert a rechercher ou traiter une EXPRESSION dans une certaine forme représentée par le".pattern"

patricktoulon à dit:

re
bonsoir excuse j'ai eu du boulot

VB:

Sub raz()
    Sheets(2).Cells.Clear
End Sub
Sub trans()
    raz
    Dim temoins As Boolean, mot$, p&, x&, oldmot$
    Application.ScreenUpdating = False
    With Sheets("base ")
        mot = ""
        For Each cel In .Range("A2:A51")
            mot = cel.Text
            If mot <> "" Then
                firstrow = Sheets("Résultat").Cells(Rows.Count, 2).End(xlUp).Offset(1).Row
                Sheets("Résultat").Cells(firstrow, 1) = mot

                With Sheets("Résultat").Cells(firstrow, 1).End(xlUp)
                    If mot <> oldmot Then .Value = .Value & vbCrLf & "(" & x & " fois)"
                End With
                x = 0
                oldmot = mot
                For i = 2 To .Cells(Rows.Count, 2).End(xlUp).Row
                    p = InStr(1, .Cells(i, 2).Value, mot)

                    If p > 0 Then
                        .Cells(i, 2).Characters(p, Len(mot)).Font.ColorIndex = 3
                        x = x + 1
                        .Cells(i, 2).Resize(, 6).Copy Destination:=Sheets("Résultat").Cells(Rows.Count, 2).End(xlUp).Offset(1)
                        Debug.Print Cells(i, 2).Address(0, 0) & " position " & p
                        p = 0
                    End If
                Next
            End If
        Next
    End With
End Sub

tu a

1. tes lignes
2. tes mots colorés
3. tes mot en debut de copie en "A"
4. et le compteur

Cliquez pour agrandir...

vraiement super
20s pour 50 mots c'est un record pour moi . avec l'ancien code recherche par mot j'ai mis 1 jour pour faire 110 mots (un par un )
j'ai voulu pousser la machine
500 mots et 5000 mots (presque 25 mn).
seule bimole il colorie les mêmes mots s'ils se trouvent dans la même phrase ( c'est un peu logique)
sinon super j'en suis trés satisfait
j'ai rajouté le gras dans l'onglet résultat
et remis la base en noir à la fin du code

laurent950 à dit:

Bonsoir patricktoulon, sousou, BOISGONTIER, dindin, Le forum

Procédure, Via module de Classe et Expression Régulière (Regex).

Fichier ci-joint avec code VBA : Option Microsoft VBScript Regular Expressions coché

j'ai 2 onglet :
- Base = OK
- résultat = OK
le premier contient les colonnes B à F = OK
en A1 le mot à rechercher dans base (colonnes B à F) = OK

Si vous avez aimez mon code, donner moi un j'aime ;-))

Laurent950

Cliquez pour agrandir...

bonjour
tout d'abord merci pour ton travail très pro pour moi qui débute en VBA
néanmoins qq remarques sur son utilité pour l'avancement de mon projet:
- temps d’exécution est trop long pour trouvé un seul mot (ce que je cherche c'est un récap du résultat de chaque)
- ai essayé 4 mots d'un coup : résultat : temps écoulé 856 s et en plus les résultats sont séparés d'une façon à reprendre tout le travail de la recherche derrière.
sinon travail très pro.
voici le travail final comme je le souhaitait et après mise en page de ma part (désolé texte en arabe)

patricktoulon à dit:

re
bonsoir excuse j'ai eu du boulot

VB:

Sub raz()
    Sheets(2).Cells.Clear
End Sub
Sub trans()
    raz
    Dim temoins As Boolean, mot$, p&, x&, oldmot$
    Application.ScreenUpdating = False
    With Sheets("base ")
        mot = ""
        For Each cel In .Range("A2:A51")
            mot = cel.Text
            If mot <> "" Then
                firstrow = Sheets("Résultat").Cells(Rows.Count, 2).End(xlUp).Offset(1).Row
                Sheets("Résultat").Cells(firstrow, 1) = mot

                With Sheets("Résultat").Cells(firstrow, 1).End(xlUp)
                    If mot <> oldmot Then .Value = .Value & vbCrLf & "(" & x & " fois)"
                End With
                x = 0
                oldmot = mot
                For i = 2 To .Cells(Rows.Count, 2).End(xlUp).Row
                    p = InStr(1, .Cells(i, 2).Value, mot)

                    If p > 0 Then
                        .Cells(i, 2).Characters(p, Len(mot)).Font.ColorIndex = 3
                        x = x + 1
                        .Cells(i, 2).Resize(, 6).Copy Destination:=Sheets("Résultat").Cells(Rows.Count, 2).End(xlUp).Offset(1)
                        Debug.Print Cells(i, 2).Address(0, 0) & " position " & p
                        p = 0
                    End If
                Next
            End If
        Next
    End With
End Sub

tu a

1. tes lignes
2. tes mots colorés
3. tes mot en debut de copie en "A"
4. et le compteur

Cliquez pour agrandir...

Bonsoir tout le monde
Désolé je relance une dernière fois ce post car certaines recherches de mot donnent des résultats qui demandent encore un tri derrière.
Exemple
La recherche du mot ami va me sortir les mots suivants : amie - tamis- rami- tatami- tsunami- amicalement-amitié ...
Je disai certains résultat me donne 500 lignes à trier une 2 ème fois pour en garder qu'une 20.
Peut-on modifier le code pour qu'il détecte que le mot ami uniquement.
Merci pour votre aide.