Suppression de ligne selon le contenant d'une cellule et d'une liste

Bonjour,

Je voudrais crée une macro pour traiter des données d'une extraction:

Par exemple : Si la cellule B de la ligne n'est pas égale à un mot de la liste alors la ligne est supprimée, en reproduisant ceci sur N ligne.

Voici la liste :

Cette liste est positionnée sur la colonne A d'une autre feuille du classeur et est destinée à pouvoir être modifier selon le besoin (taille, Information)

Je vous remercie d'avance pour votre aide :)

Bonjour,

C'est une liste à deux dimensions ou alors les données peuvent être réparties sur une seule ligne et/ou colonne ?

Bibu

Bonjour Bibu,

La liste peut-être sur une colonne , elle est sous cette forme ici pour simplifier la lecture

Voilà, vous pouvez utiliser ça :

Sub suppressionSelonCritere(ByVal ligne_index As Integer)

' --- --- --- By BibuNesco --- --- --- '

    Dim Ws_source As Worksheet
    Set Ws_source = ThisWorkbook.Worksheets("Feuil1")   ' Feuille de la liste des critères à respecter

    Dim Ws_cible As Worksheet
    Set Ws_cible = ThisWorkbook.Worksheets("Feuil2")    ' Feuille où l'on va supprimer les lignes

    derlig_source = Ws_source.Range("A" & Rows.Count).End(xlUp).Row     ' Création d'un tableau avec la liste des critères
    Dim tab_source() As Variant                                         ' En supposant que la liste est sur une seule colonne partant de A1
    tab_source = Ws_source.Range("A1", "A" & derlig_source).Value

    derlig_cible = Ws_cible.Range("B" & Rows.Count).End(xlUp).Row

    For i = ligne_index To derlig_cible
        compteEgalite = 0
        For j = 1 To UBound(tab_source, 1)
            If tab_source(j, 1) = Ws_cible.Range("B" & i) Then
                compteEgalite = compteEgalite + 1
            End If
        Next j
        If compteEgalite = 0 Then
            Ws_cible.Range("B" & i).EntireRow.Delete
            Call suppressionSelonCritere(i)
        End If
    Next i

End Sub

Et appeler ce sub en utilisant le code suivant :

Call suppressionSelonCritere(1)

C'est une fonction récursive qu'on appelle en commençant à l'index de ligne 1, c'est à dire au début, et ensuite dès qu'une ligne est supprimée on va rappeler cette fonction à l'endroit ou l'on a supprimé la ligne.

Bibu

C'est parfait cela marche parfaitement, ca vas me faire gagner pas mal de temps et aussi m'en appendre plus sur le VBA :)

Je te remercie beaucoup.

j'aurai une autre question si possible.

Comment je pourrais faire pour convertir chaque ligne l'une après l'autre en partant par exemple de la colonne B ?

Je ne peux pas convertir toute la plage d'un coup, car ma Chaîne de caractères n'est pas de même dimension selon chaque ligne et se convertie mal lors de la conversion.

Mon raisonnement final est de pouvoir copier d'une feuille, la colonne D pour garder un référencement et E pour la convertir dans une autre feuille et mettre en couleur les lignes dans la première feuille qui n'ont pas été supprimer par la macro d'avant.

Tu entend quoi par conversion ?

Par conversion, j'entend un éclatement dans plusieurs cellules de chaque thermes dans les chaînes de caractères suivantes :

Le but est de placer chaque therme dans une cellule après chaque espace exemple: WMI0/D/CP/LR/911.0/2249.0/2249.0/Ect...

Comme tu peux le voir au dessus chaque ligne n'a pas la même longueur donc lorsque j'utilise la fonction convertir cela ne fonctionne pas bien d'où le fait que je cherche quelque chose pour traiter chaque ligne indépendamment.

Je ne connais pas suffisamment les macros pour faire une répétition sur chaque ligne de la fonction jusqu'à une cellule vide :/

J'ai un problème supplémentaire mais si tu a une solution sinon je ferais par logique, Le SANS après le STD correspond à une cellule mais sur la ligne du dessous le FAUX MT RAIN-PLACAGE correspond également à une cellule mais comme il y a des espaces ceci est éclater en 3 cellules et je ne sait pas comment résoudre ce problème.

Tu peux utiliser la fonction Split elle te fera ça très bien,

Joins moi le fichier, ou du moins la forme qu'il a et je peux même te le faire en quelques minutes :)

Bibu

Voici ce que j'utilise dans l'extraction, j'ai coupé le reste car donnée pro.

Si possible de seulement donnée le code VBA car je n'ouvre pas de fichier inconnu pour raison de sécurité

je te remercie pour ton aide :)

Voilà, tu peux utiliser ça

Private Sub separation()

' --- --- --- By BibuNesco --- --- --- '

    Dim Ws_source As Worksheet
    Set Ws_source = ActiveSheet

    derlig_source = Ws_source.Range("B" & Rows.Count).End(xlUp).Row

    Dim tab_source() As Variant

    tab_source = Ws_source.Range("B2", "B" & derlig_source).Value

    For i = 1 To UBound(tab_source, 1)

        index_ligne = i + 1

        arr = Split(tab_source(i, 1), " ")

        For j = LBound(arr, 1) To UBound(arr, 1)

            Ws_source.Cells(index_ligne, 3 + j).Value = arr(j)

        Next j

    Next i

End Sub

Bibu

Je te remercie, ca fonctionne parfaitement.