Autres Code VBA pour recherche et copie/coller de ligne avec mot clé.

[Corentin26270]

Bonjours à tous,

Un amis, qui a trouvé la solution à son problème ici, m'a conseillé de faire appel à la communauté Excel-downloads.
je remercie les personnes qui font vivre ce site et qui nous permettre de régler nos pb VBA en équipe.

mon projet,
j'ai créer une TextBox1 qui recherche dans les feuilles du classeur la ou les mot(s) inscrit.
Ensuite elle est sensée me renvoyer les lignes (15 première colonnes suffirait) comportant ces mots vers une "zone identifié" (soit à partir de la cellule O3 de la feuille de calcule "Info IPS")

Mais je n'arrive à rien , même avec l'aide des IA.
Il me faut des vrais cerveaux bien entrainé.

j'aimerai bien que les mots de la TextBox apparaissent en souligné dans les lignes copiées... mais c'est l'étape finale.

mon code actuel :

Private Sub TextBox1_Change()

    Dim ws As Worksheet

    Dim wsInfoIPS As Worksheet

    Dim keyword As String

    Dim searchRange As Range

    Dim copyRange As Range

    Dim destRow As Long

    Dim cell As Range

    Dim firstFound As Boolean



    ' référence à la feuille "Info IPS"

    Set wsInfoIPS = ThisWorkbook.Sheets("Info IPS")

  

    ' effacé le contenu précédent dans "Info IPS" à partir de la cellule O3

    wsInfoIPS.Range("O3").CurrentRegion.ClearContents

  

    ' récupére le mot-clé depuis TextBox

    keyword = LCase(Me.TextBox1.text) ' convertir sans casse

  

    ' initialisation de l'indicateur

    firstFound = True

  

    ' boucler à travers toute les feuilles du classeur

    For Each ws In ThisWorkbook.Worksheets

        If ws.Name <> "Info IPS" Then ' Ne pas traiter la feuille "Info IPS" elle-même !!!

            ' définir la plage de recherche dans la feuille actuelle

            Set searchRange = ws.UsedRange

          

            ' parcourir chaque cellule dans la plage de recherche

            For Each cell In searchRange

                ' vérifier si la cellule contient le mot-clé

                If InStr(1, LCase(cell.Value), keyword) > 0 Then

                    ' si le mot-clé est trouvé, copier la ligne entière

                    If firstFound Then

                        Set copyRange = cell.EntireRow

                        firstFound = False

                    Else

                        ' ajouter la ligne à copyRange en ajustant la plage actuelle

                        Set copyRange = Union(copyRange, cell.EntireRow)

                    End If

                End If

            Next cell

        End If

    Next ws

  

    ' vérifier si des données ont été trouvé

    If Not copyRange Is Nothing Then

        ' déterminer la ligne de destination dans "Info IPS"

        destRow = wsInfoIPS.Cells(wsInfoIPS.Rows.count, "O").End(xlUp).row + 1

      

        ' copier les lignes trouvées dans la feuille "Info IPS"

        copyRange.Copy Destination:=wsInfoIPS.Cells(destRow, "O")

    End If

End Sub

Pensez vous que je puissent aboutir mon code, ou je suis à coté de la plaque ?

 

[wDog66]

Bonjour Corentin26270,

Votre ami à dû oublier de vous dire de lire la charte

Charte et règlement des forums

A lire avant de poster sur nos forums.

excel-downloads.com

Et notamment :
2.5 – La possibilité de joindre des fichiers est donnée sur ce forum. Ne pas hésiter à utiliser cette fonction, tout en veillant à ce que les données soient fictives et donc qu’aucune donnée confidentielle, nominative ne soit dans le fichier.

Le code donné doit être mis entre balises avec le bouton

A+

 

[Corentin26270]

Bonjour Corentin26270,

Votre ami à dû oublier de vous dire de lire la charte

Charte et règlement des forums

A lire avant de poster sur nos forums.

excel-downloads.com

Et notamment :
2.5 – La possibilité de joindre des fichiers est donnée sur ce forum. Ne pas hésiter à utiliser cette fonction, tout en veillant à ce que les données soient fictives et donc qu’aucune donnée confidentielle, nominative ne soit dans le fichier.

Le code donné doit être mis entre balises avec le bouton
Regarde la pièce jointe 1200339

A+

Bonjour wDog66,

j'ai bien lu la charte, mais mon classeur est remplit de donnée confidentiel. pense tu que je doivent en créer un spécifique pour l'exercice ?

Merci pour les balises, c'est bien mieux ^^

 

[Phil69970]

Bonjour à tous

@Corentin26270

Rien ne t’empêche de fournir un fichier représentatif

C'est quoi représentatif ?

- représentatif, même organisation des lignes et des colonnes, mêmes libellés, même nom des TS, mêmes noms de feuilles...
- anonymisé, pas de données personnelles réelles tels nom, n° sécu, adresse ... remplacé par Nom1, Nom2 etc ....
- simplifié, une quinzaine de lignes reproduisant l'ensemble des différents cas envisageables (Avec le résultat souhaité éventuellement)

Si cela fonctionne sur le fichier fourni et pas sur le vrai fichier c'est qu'il n'est en rien représentatif ou que tu n'as pas su transposer ce qui devrait être un simple copier coller du code.

Bonne lecture

 

[Corentin26270]

Salut Phil69970,

vous avez réussit à me convaincre qu'un tableau représentatif serait un bon exercice ;-)

j'espère que vous ne me tiendrais pas rigueur sur la simplicité de celui-ci ...

Que pensez vous des prémisses de mon code ?

 

[Phil69970]

@Corentin26270

Mon petit doigt n'est pas sur du tout que ton fichier soit représentatif !!!!

 

[Corentin26270]

Ton petit doigt a surement raison, car il met impossible de prédire les difficultés que je vais rencontrer !!!
On est sûr de rien quand on débute, mais ça me poussera à réfléchir une peu .. le nom des feuilles ne pose pas de problèmes.
j'ai ajouter la possibilité d'avoir plusieurs mots recherchés dans la même cellule. c'est un cas important que j'avais effectivement oublier. traiter les doublons et l'ordre des mots.

 

[wDog66]

Re,

Comme quoi avant tout lancement de projet... établir un cahier des charges clair et détaillé

Et coller ces valeurs sans avoir la feuille concernée, est-ce que cela à un intérêt
Et quel est le but dans la vraie vie ?

 

[Corentin26270]

ler ces valeurs sans avoir la feuille concernée

Re,

Comme quoi avant tout lancement de projet... établir un cahier des charges clair et détaillé

Et coller ces valeurs sans avoir la feuille concernée, est-ce que cela à un intérêt
Et quel est le but dans la vraie vie ?

Et coller ces valeurs sans avoir la feuille concernée, est-ce que cela à un intérêt ?
=> non nécessaire
Et quel est le but dans la vraie vie ?
Trop peu réfléchit à la question... on ferra un autre poste

 

[wDog66]

re,

Bon Ok à la prochaine avec cahier des charges alors

 

[Phil69970]

Re

@Corentin26270

Je te propose ce fichier
J'ai commenté le code ainsi que la feuille "Info IPS"

Merci de ton retour

 

[Corentin26270]

Re

@Corentin26270

Je te propose ce fichier
J'ai commenté le code ainsi que la feuille "Info IPS"

Merci de ton retour

Phil69970,
Déjà, Merci de t'être penché sur mon problème.
ça fonctionne bien, et avec peu de ligne de code !!! c'est incroyable d'arriver à faire ça en aussi peu de temps. BRAVO

J'ai l'impression de pas reconnaitre mon code initial, c'est plus de l'aide à ce stade .... mdr

Ton petit doigt avais donc raison :
1/ j'ai mal exprimé la fonction de recherche : la fonction voulue doit rechercher le(s) mot(s) entier de façon approximative dans une cellule.
Les cellules copies peuvent contenir un ou plusieurs mot/suite de caratère/chiffre recherché (le mieux serait de les trier par pertinence = nbr de mots trouvé).

Exemple :
si je tape "CHA" => les lignes comportant "chat 1" ou "Chat1" ou "chat2" ... seront copiées.
si je tape "12 CHAT" => les ligne comportant "chat12" ou "Chat 12" ou "12" ou "chat" ... seront copiées.

j'ai pensé ajouter une fonction (alors c'est pas vraiment du surlignage mais ça fait le travail) :

Sub HighlightSearchWords(rng As Range, searchTerm As String)
    Dim words() As String
    Dim word As Variant
    Dim cell As Range
    Dim startPos As Long
    Dim totalLength As Long
    
    words = Split(searchTerm, " ")
    
    For Each word In words
        For Each cell In rng.Cells
            startPos = InStr(1, cell.Value, word, vbTextCompare)
            If startPos > 0 Then
                totalLength = Len(word)
                With cell.Characters(startPos, totalLength).Font
                    .Color = RGB(255, 255, 0)
                    .Bold = True
                End With
            End If
        Next cell
    Next word
End Sub

 

[Corentin26270]

Apres un peu (pas mal) d'aide de la part de Phil69970, la fonction recherche aproximative avec plusieurs mots marche !! les lignes se copies efficacement et les mots recherchés apparaissent en rouge. je publie la tableau représentatif pour que tt le monde puisse en profiter ^^ a +

​