Supprimer ligne suivant valeur

[isarian]

Bonjour,

Je cherche à supprimer une ligne à partir d'une valeur qui peut se trouver n'importe où dans mon tableau.

J'ai un code me permettant de supprimer ce qui se trouve en colonne A uniquement

Code :

1
2
3
4
5
6
7
8
9
10
Sub supLignes()
  Application.ScreenUpdating = False
  Set Dico = CreateObject("Scripting.Dictionary")
  For Each c In Sheets("trie").[A1].CurrentRegion:  Dico(c.Text) = "":  Next c
  J = 1
  Set f = Sheets("Base de donnée")
  Do While f.Cells(J, 1) <> ""
    If Dico.Exists(Left(f.Cells(J, 1), 5)) Then f.Rows(J).Delete Else J = J + 1
  Loop
End Sub

Je ne vois pas trop comment faire pour elargir le champs de recherche.

Quelqu'un aurais une idée?

Merci d'avance.

Isa

[ZebreLoup]

Ca va marcher si tes lignes sont remplies :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Sub supLignes()
  Dim I, J As Long
  Dim exis As Boolean
  Application.ScreenUpdating = False
  Set Dico = CreateObject("Scripting.Dictionary")
  For Each c In Sheets("trie").[A1].CurrentRegion:  Dico(c.Text) = "":  Next c
  J = 1
  Set f = Sheets("Base de donnée")
  Do While f.Cells(J, 1) <> ""
    I = 1
    Exis = False
    Do While f.Cells(J, I) <> "" And Exis = False
       If Dico.Exists(Left(f.Cells(J, I), 5)) Then 
          f.Rows(J).Delete 
          Exis = True
       Else 
          I = I + 1
       End If
    Loop
    J = J + 1
  Loop
End Sub

[isarian]

Je te remercie pour la rapidité et l'effacité,

Je viens de testé ton code malheureusement,

Il fonctionne bien pour les 4 premières colonne mais si j'essaie de faire pour la colonne J. Cela ne marche pas.

Une idée?

Cordialement

Isa

Ensuite le soucis est que le texte que je cherche (dans trie) peux se trouver n'importe ou dans la cellule.

Donc je crainds que Left ne marche pas dans ce cas, mais je ne sais pas par quoi le remplacer .


Je dois également chercher des valeurs comme,

clôturepr2010
CPAS
RFI
...

Mille merci d'avance.

Isa

[ZebreLoup]

Dans ce cas, il faut utiliser la fonction InStr, mais en bouclant sur tous les mots que tu as à chercher. Tu ne pourras pas utiliser la méthode Exists du dictionnaire

[isarian]

Par contre j'ai remarqué qu'avec le code que j'avais, si j'ai une colonne vide, il passe à la ligne suivant.

Hors effectivement je peux avoir une colonne vide entre.

je continue à regarder.

Merci de l'info.

Voilà j'ai trouvé, bon je vais devoir malheureusement trouvé un moyen d'utilisé le style de dico. Une idée?

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Sub supLignes()  Dim I, J As Long
  Dim exis As Boolean
  Application.ScreenUpdating = False
  'Set Dico = CreateObject("Scripting.Dictionary")
 ' For Each c In Sheets("trie").[A1].CurrentRegion:  Dico(c.Text) = "":  Next c
  J = 1
  Set f = Sheets("Base de donnée")
  Do While f.Cells(J, 1) <> ""
    I = 1
    exis = False
    Do While I < 11 And exis = False
       'If Dico.Exists(Left(f.Cells(J, I), 5)) Then
       If InStr(f.Cells(J, I), "Clôturepr") > 0 Then
          f.Rows(J).Delete
          exis = True
       Else
          I = I + 1
       End If
    Loop
    J = J + 1
  Loop
End Sub

[ZebreLoup]

Regarde le code que je te propose :

Code :

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
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
Option Explicit
 
Public Sub test()
    Dim listMots As New Collection
    Dim c As Range
 
    For Each c In Sheets("trie").[A1].CurrentRegion
        listMots.Add c.Text
    Next c
 
    Dim r As Range
    Set r = Sheets("Base de donnée").UsedRange
 
    supprimerLesLignesContenant listMots, r
End Sub
 
Private Sub supprimerLesLignesContenant(ByRef listeMotsInterdits As Collection, ByRef rg As Range)
    Dim iCol, iRow As Long
    Dim i As Integer
    Dim currentValue As String
    Dim toDelete As Boolean
 
    iRow = rg.Rows.Count
 
    Do While iRow >= 1
        iCol = rg.Columns.Count
 
        Do While iCol >= 1
            currentValue = rg.Cells(iRow, iCol).Text
 
            i = 0
            toDelete = False
 
            If currentValue <> "" Then
                Do While i <= listeMotsInterdits.Count And toDelete = False
                    If InStr(listeMotsInterdits(i), currentValue) > 0 Then
                        toDelete = True
                    Else
                        i = i + 1
                    End If
                Loop
            End If
 
            If toDelete Then
                iCol = 0
                rg.Cells(iRow, 1).EntireRow.Delete
            Else
                iCol = iCol - 1
            End If
 
        Loop
 
        iRow = iRow - 1
    Loop
End Sub

[isarian]

Merci je viens de testé,

il me fait l'erreur suivante:

Erreur D'exécution '9':
L'indice N'appartient pa à la sélection,

Et cela s'arrête à la ligne 36

Merci pour ton aide.

[ZebreLoup]

remplace i=0 par i=1. J'avais oublié que pour les collections, ce n'est pas comme les tableaux, ça ne commence pas à 0

[isarian]

Cool nikel, merci MILLE FOIS,

Juste un petit bémol, toute mes lignes ne sont pourtant pas enlever.

Est ce qu'une colonne vide pourrais en être la causes?