Discussion :

[Jackbel]

Bonsoir,
Je suis débutante dans VBA et je l’utilise surtout avec la fonction d’enregistrement et je modifie ensuite quelques critères. Mais là, je suis depuis quelques heures sur un problème que je n’arrive pas à résoudre, même en cherchant dans les forums.
J’ai une feuille excel avec plusieurs colonnes et plusieurs lignes.
Dans la colonne D, j’ai un numéro de référence.
Pour chaque numéro de référence, j’ai plusieurs lignes, pas toujours le même nombre de lignes.
Le même numéro de référence se répète sur les lignes.
Je recherche un critère dans la colonne C (par exemple : PAIEMENT) et si je le trouve, je veux garder toutes les lignes de la même référence. Celles-ci peuvent se situer en dessus ou en dessous de la ligne dans laquelle j’ai trouvé PAIEMENT.
Par contre, si je ne trouve pas le critère de recherche PAIEMENT, je veux effacer tous les autres numéros de référence et lignes correspondantes.
Exemple :
ColA ColB ColC ColD
12.01.17 56.- 8887 ITEM
12.01.17 8 8887 TAXSUMMARY
12.01.17 78.- 8888 PAIEMENT
12.01.17 90.- 8888 ITEM
12.01.17 8 8888 TAXSUMMARY
12.01.17 77.- 8989 ITEM
12.01.17 8 8989 TAXSUMMARY
12.01.17 66.- 8990 ITEM
12.01.17 64.- 8990 ITEM
12.01.17 43.- 8990 ITEM
12.01.17 8 8990 TAXSUMMARY

Dans cette exemple, j’aimerais garde uniquement les lignes qui ont la référence 8888 car le critère de recherche est présent.
Merci pour votre aide.

[Invité]

Bonjour,

A tester :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
Option Explicit
 
Sub EliminerLesNumerosDeFacturesNonPayees()
 
Dim AirePosition As Range, CellulePosition As Range
Dim NbPaye As Long, I As Long
Dim MatriceFactures() As Variant
Dim Continuer As Boolean
 
    Set AirePosition = Sheets("Feuil1").UsedRange.Columns(4).Cells
    NbPaye = 0
    For Each CellulePosition In AirePosition
        If CellulePosition = "PAIEMENT" Then
           ReDim Preserve MatriceFactures(NbPaye)
           MatriceFactures(NbPaye) = CellulePosition.Offset(0, -1)
           NbPaye = NbPaye + 1
        End If
    Next CellulePosition
 
    For Each CellulePosition In AirePosition
        Continuer = True
        For I = LBound(MatriceFactures) To UBound(MatriceFactures)
            If "'" & CellulePosition.Offset(0, -1) = "'" & MatriceFactures(I) Then Continuer = False
        Next I
        If Continuer = True And CellulePosition.Row > 1 Then Range(CellulePosition.Offset(0, -3), CellulePosition).ClearContents
    Next CellulePosition
    Set AirePosition = Nothing
 
End Sub

[Jackbel]

Bonjour Eric

Merci. J'ai modifié juste 2 choses. Le nom de la feuille (par "complet") et le nom du critère de recherche (par "LDCPAYMENT").
J'ai laissé tout le reste mais malheureusement ça ne fonctionne pas.
Ca plante au niveau

For I = LBound(MatriceFactures) To UBound(MatriceFactures)

Une idée ?
Autre question. Mon critère de recherche se trouve dans la colonne 3, ne faudrait-il pas mettre Columns(3) dans

Set AirePosition = Sheets("Complet").UsedRange.Columns(4).Cells

Merci.

[Invité]

Bonjour,

Le code fourni correspond à l'exemple que vous avez mis en ligne. Si l'emplacement de vos données a changé, il vous faut bien sûr adapter le code.
C'est vrai que s'il n'y a aucune ligne avec Paiement, il voudrait mieux tester la variable NbPaye (If NbPaye > 0 then) avant de lancer la boucle For I = LBound(MatriceFactures) To UBound(MatriceFactures)

[Jackbel]

Non, ça n'a pas changé.
Le critère de recherche LCDPAIEMENT se trouve dans la colonne C, donc la 3ème colonne.
C'est le numéro unique de référence qui se trouve dans la colonne D.

Qu'est-ce qui est correct ?

Set AirePosition = Sheets("Complet").UsedRange.Columns(4).Cells ou Set AirePosition = Sheets("Complet").UsedRange.Columns(3).Cells ?

J'ai essayé en insérant 3, et il bloque un peu plus bas:

If Continuer = True And CellulePosition.Row > 1 Then Range(CellulePosition.Offset(0, -3), CellulePosition).ClearContents

Faut-il modifier quelque chose ici?

Il y aura toujours des LCDPAIEMENT, donc la vérification n'est peut-être pas nécessaire mais je la rajouterai dès que la macro fonctionnera.

Merci.

[Invité]

.

Regardez comment fonctionne l'exemple du fichier joint. A vous de l'adapter.