Je viens à vous, car j'ai besoin d'adapter une formule faites par "Eric" à un nouveau fichier. Cependant, il y'a un TCD à l'intérieur de celui-ci. L'objectif du code est de mettre un "X" à chaque fois qu'un mot clé est rencontré dans une des phrase (en colonne 1). (Mots clés enregistré en feuille 2 nommé dictionnaire.) Voici le code : Option Explicit Option Compare Text Sub motCle() 'Déclaration des variables comme texte, aucun comme vrai ou faux' Dim phr, motCle() As String, dict, aucun As Boolean 'Déclaration des variables comme nombre entier' Dim lig1 As Long, lig2 As Long, col2 As Long, i As Long ' charger le dictionnaire en mémoire dict = Sheets("Dictionnaire").[A1].CurrentRegion.Value ' charger les phrases en mémoire phr = [A6].Resize(Cells(Rows.Count, 1).End(xlUp).Row - 5).Value ' préparation du tableau résultats ReDim motCle(1 To UBound(phr), 1 To UBound(dict, 2)) For lig1 = 1 To UBound(phr) ' pour chaque phrase aucun = True For col2 = 2 To UBound(dict, 2) ' pour chaque rubrique For lig2 = 1 To UBound(dict, 1) If dict(lig2, col2) = "" Then ' plus de mots dans cette rubrique Exit For ElseIf InStr(phr(lig1, 1), dict(lig2, col2)) > 0 Then ' si le mot a été détecté motCle(lig1, col2) = "X" ' cocher la rubrique concernée aucun = False Exit For ' et inutile de continuer pour cette rubrique End If Next lig2 Next col2 If aucun Then motCle(lig1, 1) = "X" Next lig1 ' coller résultat [B6].Resize(UBound(motCle, 1), UBound(motCle, 2)) = motCle End Sub Je met en PJ le fichier pour lequel la macro ne fonctionne pas ! Merci d'avance à tous ...

VBA sur TCD

Le 27/10/2017 à 16:24

Bonjour à tous !

Je viens à vous, car j'ai besoin d'adapter une formule faites par "Eric" à un nouveau fichier. Cependant, il y'a un TCD à l'intérieur de celui-ci.

L'objectif du code est de mettre un "X" à chaque fois qu'un mot clé est rencontré dans une des phrase (en colonne 1).

(Mots clés enregistré en feuille 2 nommé dictionnaire.)

Voici le code :

Option Explicit
Option Compare Text

Sub motCle()
'Déclaration des variables comme texte, aucun comme vrai ou faux'
    Dim phr, motCle() As String, dict, aucun As Boolean
    'Déclaration des variables comme nombre entier'
    Dim lig1 As Long, lig2 As Long, col2 As Long, i As Long
    ' charger le dictionnaire en mémoire
    dict = Sheets("Dictionnaire").[A1].CurrentRegion.Value
    ' charger les phrases en mémoire
    phr = [A6].Resize(Cells(Rows.Count, 1).End(xlUp).Row - 5).Value
    ' préparation du tableau résultats
    ReDim motCle(1 To UBound(phr), 1 To UBound(dict, 2))

    For lig1 = 1 To UBound(phr)
        ' pour chaque phrase
        aucun = True
        For col2 = 2 To UBound(dict, 2)
            ' pour chaque rubrique
            For lig2 = 1 To UBound(dict, 1)
                If dict(lig2, col2) = "" Then
                    ' plus de mots dans cette rubrique
                    Exit For
                ElseIf InStr(phr(lig1, 1), dict(lig2, col2)) > 0 Then
                    ' si le mot a été détecté
                    motCle(lig1, col2) = "X" ' cocher la rubrique concernée
                    aucun = False
                    Exit For ' et inutile de continuer pour cette rubrique
                End If
            Next lig2
        Next col2
        If aucun Then motCle(lig1, 1) = "X"
    Next lig1
    ' coller résultat
    [B6].Resize(UBound(motCle, 1), UBound(motCle, 2)) = motCle
End Sub

Je met en PJ le fichier pour lequel la macro ne fonctionne pas !

Merci d'avance à tous !

17test.xlsx (22.77 Ko)

Le 30/10/2017 à 09:37

Up !

Le 30/10/2017 à 17:16

Up again !

Le 30/10/2017 à 21:31

Bonjour

Si au lieu de créer un nouveau fil tu avais répondu sur l'ancien pour qu'on comprenne le début de l'histoire tu aurai sans doute eu des réponses !

Remplace sur l'avant dernière ligne [B6] par [C6] puisque tes X doivent s'inscrire à partir de C et non plus B

Le 31/10/2017 à 16:59

Bonjour !

Le problème c'est que j'ai mis en résolu, donc je pensais qu'il fallait faire un nouveau sujet.

Mais vous avez résolu mon problème fallait aussi changer une autre ligne pour l'adapter au fichier final.

Merci de votre réponse,

bien cordialement.