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

Corentin26270

XLDnaute Nouveau
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 :
VB:
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 ?
 
Dernière édition:

wDog66

XLDnaute Occasionnel
Bonjour Corentin26270,

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

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
1720616640946.png


A+
 

Corentin26270

XLDnaute Nouveau
Bonjour Corentin26270,

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

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

XLDnaute Barbatruc
Bonjour à tous

@Corentin26270

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

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

XLDnaute Nouveau
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.
 

Pièces jointes

  • Classeur Excel Downloads v1 .xlsm
    29.6 KB · Affichages: 4

wDog66

XLDnaute Occasionnel
Re,

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

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

XLDnaute Nouveau
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é :rolleyes:

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
 

Corentin26270

XLDnaute Nouveau
Re

@Corentin26270

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

Merci de ton retour
:oops:
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) :

VB:
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

XLDnaute Nouveau
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 +

 

Pièces jointes

  • Recherche mots et copie ligne V2 .xlsm
    35.3 KB · Affichages: 0

Discussions similaires

Statistiques des forums

Discussions
313 322
Messages
2 097 144
Membres
106 851
dernier inscrit
Rv34