Supprimer lignes autour d'une ligne, càd en "packs"

Bonjour à tous,

Je cherche un traitement, certainement plus simple à réaliser sous SQL, mais je pense qu'une macro VBA peut s'en charger surtout sur un volume de lignes restreint (1500).

Il s'agit d'une base, avec plusieurs champs en colonne (10).

Cette base a une structure atypique puisque les individus ne représentent pas une ligne, mais un "tas" de ligne dont la taille peut varier.

Voici un fichier excel en exemple.

==========>

• Je souhaiterais que si le programme détecte la présence de la clé dans le "pack", il supprime tout le pack, et fasse cette vérification pour toutes les clés, et tous les packs.
• Je ne veux conserver que les "packs" dont les clés ne sont pas mentionnées.

Dans mon exemple, je veux supprimer tous les packs qui contiennent au moins 1 fois dans le champs "items2", les clés qui sont en "L2:L4".

L'idéal serait que le programme amène une inputbox qui permet de copier coller les clés séparées par un ";", et que ce même programme supprime tous les packs contenant ces clés.

Merci beaucoup par avance,

G.

Bonjour

Un essai à tester. Te convient-il ?

Bye !

Bonsoir le fil,

A tester :

Option Explicit
Sub test()
Dim myAreas As Areas, myArea As Range, x As Range, i As Byte, y, maListe
    maListe = Range("l2:l4").Value
    Set myAreas = Range("b2", Range("b" & Rows.Count).End(xlUp)).SpecialCells(2).Areas
    For Each myArea In myAreas
        For i = 1 To UBound(maListe, 1)
            y = Application.Match(maListe(i, 1), myArea, 0)
            If IsNumeric(y) Then
                If x Is Nothing Then
                    Set x = myArea.Offset(, -1).Resize(, myArea.CurrentRegion.Columns.Count)
                Else
                    Set x = Union(x, myArea.Offset(, -1).Resize(, myArea.CurrentRegion.Columns.Count))
                End If
                Exit For
            End If
        Next
    Next
    If Not x Is Nothing Then x.Select
    'If Not x Is Nothing Then x.EntireRow.Delete
End Sub

klin89

Merci pour vos réponses.

La solution de gmb fonctionne assez bien déjà, j'ai appliqué le code à un fichier "réel".

Malgré un encombre qui s'identifie au niveau du "GoTo suite:" dans le 3ème test.

Sub Supprimer()

    Range("R2:AA" & Rows.Count).Clear
    Set plageClefs = Range("O2:O" & Range("O1").End(xlDown).Row)
    For ln = 2 To Range("E" & Rows.Count).End(xlUp).Row
        If Range("A" & ln) <> "" Then
            If ln = 2 Then
                plage = Range("A" & ln & ":M" & Range("A" & ln).CurrentRegion.Rows.Count)
            Else
                plage = Range("A" & ln & ":M" & Range("A" & ln).CurrentRegion.Rows.Count + ln - 1)
            End If
            'plage.Select
            flag = 0
            For Each c In plageClefs
                For i = 1 To UBound(plage, 1)
                    If plage(i, 2) = c Then
                        flag = 1
                        GoTo suite

                   End If
                Next i
            Next c
suite:
            If flag = 0 Then
                lgn = Range("R" & Rows.Count).End(xlUp).Row
                lgn = lgn + Range("R" & lgn).CurrentRegion.Rows.Count + 1
                'Range("R" & lgn).Resize(UBound(plage, 1), UBound(plage, 2)) = plage
                Range("A" & ln & ":M" & ln + UBound(plage, 1) - 1).Copy Range("R" & lgn)
                Erase plage
            End If
        End If
    Next ln

End Sub

Il se passait en fait que lorsque mes valeurs à tester n'étaient plus en B:B mais en D:D, j'avais une erreur sur ce test, et le programme ne supprimait pas correctement les packs.

Je teste ta solution Klin89 pour voir.

G.

Salut gmb, Klin89.

Vos programmes marchent tout les deux très bien.

Une question :

- Est-ce compliqué de penser un programme qui fonctionne en sens inverse ?

Dans ce cas il n'y aura plus de question d'occurrence ou de clé identificatrice comme critères de suppression.

Tous mes packs sont espacés par des lignes vides.

Je voudrais recompresser les lignes d'un pack en une seule

Une idée de solution ?

Merci pr avance,

G.

Bonjour

Un essai à tester. Te convient-il ?

Bye !

Ca marche super.

Je vais le test sur un bon gros fichier des familles et bien capricieux.

Merci beaucoup,

G.