XL 2021 Rechercher les prénoms

[sonskriverez]

Bonjour le Forum,

Dans mon fichier j'ai 2 onglets et phrase. Je voudrais en utilsant les prénoms de l'onglet "Prénoms", surlignier toutes les cellules de l'onglet "Phrase" contenant un prénom.

MErci de votre aide

 

[Gégé-45550]

Bonjour le Forum,

Dans mon fichier j'ai 2 onglets et phrase. Je voudrais en utilsant les prénoms de l'onglet "Prénoms", surlignier toutes les cellules de l'onglet "Phrase" contenant un prénom.

MErci de votre aide

Bonjour,
Un essai mais ... vu l'étendue de la liste des prénoms, la macro ressort plein de scories ; exemple, le prénom anson est trouvé dans tous les titres contenant le mot "chanson", et les exemples de ce type fourmillent.
Cordialement,

 

[vgendron]

Bonjour

une propostion avec une macro à mettre dans un module standard

et au préalable.. il faut supprimer les lignes qui affichent "#Valeur" dans ta colonne B de phrases
à noter que vu la quantité de lignes à traiter.. la macro prend près de 7mn

Sub Colorer2()
    Dim TabPh() As Variant
    Dim TabPré() As Variant
    Dim DicoPré As Object
    
    Set DicoPré = CreateObject("Scripting.dictionary")
    
    deb = Timer
    With Sheets("Prénoms")
        TabPré = .Range("A1").CurrentRegion.Value
        For i = LBound(TabPré, 1) To UBound(TabPré, 1)
            clé = TabPré(i, 1)
            If Not DicoPré.exists(clé) Then DicoPré.Add clé, i
        Next i
    End With
    With Sheets("Phrase")
        LastLine = .Range("B" & .Rows.Count).End(xlUp).Row
        TabPh = .Range("B2:C" & LastLine).Value
        
        For i = LBound(TabPh, 1) To UBound(TabPh, 1)
            For Each clé In DicoPré.keys
            'MsgBox clé
                If UCase(Trim(TabPh(i, 1))) = UCase(clé) Or InStr(1, UCase(TabPh(i, 1)), " " & UCase(clé) & " ") <> 0 Or InStr(1, UCase(TabPh(i, 1)), UCase(clé) & " ") <> 0 Or InStr(1, UCase(TabPh(i, 1)), " " & UCase(clé)) <> 0 Then
                    TabPh(i, 2) = clé
                    Exit For
                End If
            
            Next clé
        Next i
 
        .Range("B2:C" & LastLine) = TabPh
    End With
    MsgBox "Opération terminée en " & Timer - deb & " s"
End Sub

 

[sonskriverez]

Bonjour,
Un essai mais ... vu l'étendue de la liste des prénoms, la macro ressort plein de scories ; exemple, le prénom anson est trouvé dans tous les titres contenant le mot "chanson", et les exemples de ce type fourmillent.
Cordialement,

Bje Gégé,

Merci pour ce travail, mais cela sélectionne beaucoup de lignes qui ne contiennent pas de prénom

 

[sonskriverez]

Bonjour

une propostion avec une macro à mettre dans un module standard

et au préalable.. il faut supprimer les lignes qui affichent "#Valeur" dans ta colonne B de phrases
à noter que vu la quantité de lignes à traiter.. la macro prend près de 7mn

Sub Colorer2()
    Dim TabPh() As Variant
    Dim TabPré() As Variant
    Dim DicoPré As Object
   
    Set DicoPré = CreateObject("Scripting.dictionary")
   
    deb = Timer
    With Sheets("Prénoms")
        TabPré = .Range("A1").CurrentRegion.Value
        For i = LBound(TabPré, 1) To UBound(TabPré, 1)
            clé = TabPré(i, 1)
            If Not DicoPré.exists(clé) Then DicoPré.Add clé, i
        Next i
    End With
    With Sheets("Phrase")
        LastLine = .Range("B" & .Rows.Count).End(xlUp).Row
        TabPh = .Range("B2:C" & LastLine).Value
       
        For i = LBound(TabPh, 1) To UBound(TabPh, 1)
            For Each clé In DicoPré.keys
            'MsgBox clé
                If UCase(Trim(TabPh(i, 1))) = UCase(clé) Or InStr(1, UCase(TabPh(i, 1)), " " & UCase(clé) & " ") <> 0 Or InStr(1, UCase(TabPh(i, 1)), UCase(clé) & " ") <> 0 Or InStr(1, UCase(TabPh(i, 1)), " " & UCase(clé)) <> 0 Then
                    TabPh(i, 2) = clé
                    Exit For
                End If
           
            Next clé
        Next i
 
        .Range("B2:C" & LastLine) = TabPh
    End With
    MsgBox "Opération terminée en " & Timer - deb & " s"
End Sub

Bjr, au bout de quelques minutes, la macro plante à la ligne "If Ucase.." erreur 13

 

[Gégé-45550]

Bje Gégé,

Merci pour ce travail, mais cela sélectionne beaucoup de lignes qui ne contiennent pas de prénom

Lorsque, dans la liste, vous avez des prénoms comme "ai", avez-vous une idée du nombre de mots qui commencent ou qui finissent par "ai", et ceci n'est qu'un exemple.
Une bonne solution, restreindre la liste des prénoms à des occurrences plus courantes.
Cdlt

 

[vgendron]

Bjr, au bout de quelques minutes, la macro plante à la ligne "If Ucase.." erreur 13

il faut lire TOUTE la réponse
au préalable.. il faut supprimer les lignes qui affichent "#Valeur" dans ta colonne B de phrases

 

[sonskriverez]

il faut lire TOUTE la réponse
au préalable.. il faut supprimer les lignes qui affichent "#Valeur" dans ta colonne B de phrases

Cà marche merci

 

[vgendron]

Cette version est "légèrement" plus rapide....

Sub Colorer3()
    Dim TabPh() As Variant
    Dim TabPré() As Variant
    Dim DicoPré As Object
    
    Set DicoPré = CreateObject("Scripting.dictionary")
    
    deb = Timer
    With Sheets("Prénoms")
        TabPré = .Range("A1").CurrentRegion.Value
        For i = LBound(TabPré, 1) To UBound(TabPré, 1)
            clé = UCase(Trim(TabPré(i, 1)))
            If Not DicoPré.exists(clé) Then DicoPré.Add clé, i
        Next i
    End With

    With Sheets("Phrase")
        LastLine = .Range("B" & .Rows.Count).End(xlUp).Row
        TabPh = .Range("B2:C" & LastLine).Value
        
        For i = LBound(TabPh, 1) To UBound(TabPh, 1)
            TabTemp = Split(TabPh(i, 1), " ")
            For j = LBound(TabTemp) To UBound(TabTemp)
                If DicoPré.exists(UCase(TabTemp(j))) Then
                    TabPh(i, 2) = TabTemp(j)
                    Exit For
                End If
            Next j
        Next i
        .Range("B2:C" & LastLine) = TabPh
    End With
    MsgBox "Opération terminée en " & Timer - deb & " s"
End Sub

 

[vgendron]

Coupléé à une MFC

 

[patricktoulon]

bonsoir
c'est un truc qui a été vu plusieurs fois ça
il y a diverses méthodes quelques une ont été abordées ici sur xld par @mapomme et d'auitres camarades ainsi que moi même
si vous cherchez avec les pseudos vous devriez trouver
certaines méthodes se sont révélées relativement très rapide

 

[patricktoulon]

re
je n'ai pavu "Les" DANS LES PR2NOMS MOI

 

[vgendron]

re
je n'ai pavu "Les" DANS LES PR2NOMS MOI
Regarde la pièce jointe 1216197

Nettoies tes lunettes.. il est entre Leroy et Lesedi

 

[patricktoulon]

re
ben va voir l'ophtalmo alors "Les" c'est pas "leroy" ou "lesedi"
si tu devais prendre en compte les syllabes ça n'aurait aucun sens car tout serait presque en rouge à mon avis
Absurde comme réflexion mes lunettes vont très bien
si tu cherche les prénoms c'est les prénoms en entier 🙄
je cite le demandeur au cas ou

Dans mon fichier j'ai 2 onglets et phrase. Je voudrais en utilsant les prénoms de l'onglet "Prénoms", surlignier toutes les cellules de l'onglet "Phrase" contenant un prénom.

je récapépète"contenant un prenom"

 

[vgendron]

à priori, c'est pas les lunettes qu'il faut nettoyer...