Chercher texte selon critères

Bonsoir,

Est-ce qu'il existe une formule pour rechercher du texte selon plusieurs critères et ensuite afficher le résultat dans une cellule en séparant les textes trouvés par une virgule par exemple ?

Du genre comme ceci :

9tcd-comment.xlsx (13.56 Ko)

Merci d'avance,

JB_,

c'est quand tu veux pour nous donner tes critères, hein !
Après tout, on n'est pas à la pièce, n'est-ce pas !?


A+

JB_,

c'est quand tu veux pour nous donner tes critères, hein !
Après tout, on n'est pas à la pièce, n'est-ce pas !?


A+

Tout vient à point à qui sait attendre

Je dirais 2 critères : FONC et CPTE dans mon exemple.

J'ai fait un petit TCD avec les critères et les résultats attendus sur la droite.

Je souhaiterais avoir dans une cellule, l'ensemble des mots qui ont les critères F1 et 0, F1 et 1 etc...

A+ & merci

Bonjour,

Essayez ceci, construit à partir du fichier fourni par vos soins, c'est à dire la colonne "FONC" contient du texte et la colonne "CPTE" contient des valeurs numériques.

Sub Recup_Commentaires()
    Dim DerLig_BDD As Long, DerLig_TCD As Long, i As Long, j As Long
    Dim Lig As Long
    Dim FONC As String, CPTE As String, C As String
    Dim D As Object
    Application.ScreenUpdating = False
    Columns("G").ClearContents
    DerLig_BDD = Range("A" & Rows.Count).End(xlUp).Row
    DerLig_TCD = Range("F" & Rows.Count).End(xlUp).Row
    Set D = CreateObject("Scripting.dictionary")
    For i = 2 To DerLig_TCD
        If Not IsNumeric(Cells(i, "F")) Then
            Lig = i + 1
            FONC = Cells(i, "F")
            Do While IsNumeric(Cells(Lig, "F")) And Lig <= DerLig_BDD
                CPTE = Cells(Lig, "F")
                For j = 1 To DerLig_BDD
                    If Cells(j, "A") = FONC And Cells(j, "B") = CPTE Then
                        C = FONC & " " & CPTE
                        D(C) = D(C) & ", " & Cells(j, "D")
                    End If
                Next j
                If D.Count > 0 Then Cells(Lig, "G").Resize(, 1) = Application.Transpose(D.items)
                D.RemoveAll
                Lig = Lig + 1
            Loop
        End If
    Next i
End Sub

le fichier (cliquez sur le bouton "Afficher liste des commentaires dans le TCD")

Cdlt

Bonjour,

Super, c'est exactement ce que je voulais merci beaucoup

Etant débutant en VBA je ne comprends pas tout au code pourriez vous mettre des petits commentaires ? J'ai commencé mais...

Bonjour,

Voilà le fichier commenté ligne par ligne.

Cdlt

Bonjour,

Une alernative au TCD avec PQ.
Cdlt.

4tcd-comment.xlsx (18.70 Ko)
capture d ecran 2021 08 06 061248

Bonjour,

@Arturo : merci pour toutes les explications, je reviendrai surement vers toi si j'ai des soucis à mettre en œuvre le code dans mon fichier original
@Jean-Eric : c'est aussi une idée, qu'elle est la manip à effectuer pour le "grouped rows" ?

Cdlt

Re,
Il y a en effet une astuce.
Quand tu groupes, tu demandes la somme des Commentaires. PQ va te retourner une erreur !
Il faut aller remplacer List.Sum par Text.Combine.
Voir fichier et requête Tableau1 (2).
A te relire.

Cdlt.

2tcd-comment.xlsx (19.42 Ko)
let
    Source = Excel.CurrentWorkbook(){[Name="Tableau1"]}[Content],
    //LignesGroupées = Table.Group(Source, {"FONC", "CPTE"}, {{"MONTANT TOTAL", each Table.RowCount(_), Int64.Type}, {"COMMENTAIRES", each List.Sum([COMMENTAIRE]), type text}})
    //remplacer List.Sum([COMMENTAIRE]) par Text.Combine([COMMENTAIRE],", ")
    LignesGroupées = Table.Group(Source, {"FONC", "CPTE"}, {{"MONTANT TOTAL", each Table.RowCount(_), Int64.Type}, {"COMMENTAIRES", each Text.Combine([COMMENTAIRE],", "), type text}})
in
    LignesGroupées

RE,

Bravo J-E c'est parfait et ça fonctionne

@Arturo : j'ai un soucis, mon fichier exemple était mal présenté et je m'en excuse. 2 choses :

- Ce ne sont pas une valeur "numérique" et une valeur "texte" mais bien 2 valeurs "texte" à chercher simultanément.

- Ma BDD se trouve sur une feuille à part.

Saurais-tu modifier le code en prenant en compte ces 2 paramètres ?

En te remerciant par avance,

cdlt,

Bonjour,

Voilà le fichier modifié

Cdlt

Super merci, j'ai du mal à mettre en place la macro dans mon fichier. Il doit y avoir une erreur dans le code que j'ai modifié car ça ne fonctionne pas. Peux-tu y jeter un œil ? J'ai changé les deux variables ART et FON.

Sub Recup_Commentaires()

    Dim DerLig_BDD As Long, DerLig_TCD As Long, i As Long, j As Long
    Dim Lig As Long
    Dim ART As String, FON As String, C As String
    Dim D As Object
    Dim f1 As Worksheet, f2 As Worksheet

    '********************************************************************************
    Application.ScreenUpdating = False
    Set f1 = Sheets("TAB_O (2)")
    Set f2 = Sheets("TOT.TOUS BUDGETS")

    f1.Columns("F").ClearContents

    DerLig_BDD = f2.Range("A" & Rows.Count).End(xlUp).Row

    DerLig_TCD = f1.Range("A" & Rows.Count).End(xlUp).Row

    Set D = CreateObject("Scripting.dictionary")

    For i = 2 To DerLig_TCD

        If Left(f1.Cells(i, "A"), 4) = "ART" Then
            Lig = i + 1
            ART = f1.Cells(i, "A")
            Do While Left(f1.Cells(Lig, "A"), 4) = "FON" And Lig <= DerLig_BDD
                FON = f1.Cells(Lig, "A")
                For j = 1 To DerLig_BDD
                    If f2.Cells(j, "H") = ART And f2.Cells(j, "J") = FON Then
                        C = ART & " " & FON
                        D(C) = D(C) & ", " & f2.Cells(j, "AK")
                    End If
                Next j

                If D.Count > 0 Then f1.Cells(Lig, "F").Resize(, 1) = Application.Transpose(D.items)
                D.RemoveAll
                Lig = Lig + 1
            Loop
        End If

    Next i

    Set f1 = Nothing
    Set f2 = Nothing
End Sub

Ci-joint impression écran de mes 2 feuilles :

TOT.TOUS BUDGETS = ma BDD

TAB_O (2) = le TCD

Les commentaires sont à afficher dans la colonne F.

tcd bdd

En te remerciant par avance

Bonjour,

Si j'avais eu le nouveau tableau, j'aurai pu faire tous les tests. mais je vois déjà une erreur; "ART" et "FON" ne font que 3 caractères , or dans le précédent fichier je testais sur 4 caractères, donc il vous faut ajuster les lignes suivantes en modifiant le nombre de caractères.

If Left(f1.Cells(i, "A"), 3) = "FON"

et

If Left(f1.Cells(i, "A"), 3) = "ART"

Je prépare un fichier car il n'y a pas que çà...

Ci-joint fichier

2tcd-recup-com.xlsm (29.30 Ko)

Voilà les modifs

RE,

En 60623 des commentaires sont présents en BDD et ne s'affichent pas en TCD

J'ai l'impression d'être un casse c*****

Bonjour,

J'avais mis un contrôle de trop; il faut remplacer cette ligne:

Do While Left(f1.Cells(Lig, "A"), 4) = "Fon." And Lig <= DerLig_BDD 'à partir de cette ligne à traiter, tant qu'elle est égale à "Fon." et que ce n'est pas la dernière

par

Do While Left(f1.Cells(Lig, "A"), 4) = "Fon." 'à partir de cette ligne à traiter, tant qu'elle est égale à "Fon."

Cdlt

Re Arturo,

Je t'en remercie. J'ai passé 1h à essayer la macro sur mon fichier mais en vain...

J'ai essayé de changer la variable i, j ... je vois pas du tout ce qui colle pas !

Ci-joint mon vrai fichier avec quelques modif mais qui n'impacterons pas le fonctionnement du code.

Le code se trouve sur le module 3.

6exemple.zip (571.64 Ko)

En te remerciant par avance

Rechercher des sujets similaires à "chercher texte criteres"