Discussion :

[eillon]

Bonjour,

Je voudrais pouvoir supprimer les lignes correspondantes à une données dans une colonne.

ex :

Msgbox => "colonnes ?"

reponse "G"

Msgbox => "valeurs?"

reponse "sams"

Supprimer les lignes qui ont "sams" en "G"

A savoir que la recherche peut se faire dans n'importe quelle colonne sur n'importe quelle valeurs (chiffres ou lettres).

[Jean-Philippe André]

bonjour,
plusieurs pistes pour toi, regarde du côté
- des inputbox
- des boucles if
- de la méthode Range().End(Xlup).Row
- de la méthode Row.Delete

[eillon]

merci pour ces pistes, mais en fait je ne connais pas le vb.
J'arrive à adatper des macros à mes besoins, mais je ne sais pas les faire.

[Jean-Philippe André]

bsr,
tu peux utiliser le macro recorder pour avoir un début de code, sinon utilise la touche F1 avec les élements que je t'ai cité dans le post précédent

[Jeannot45]

Bonjour,

je te joins le code qui va te permettre de réaliser ton problème. Cependant, je te conseille de lire les commentaires que j'y ai placé et de consulter l'aide pour avoir de plus amples détails.

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
Sub SupprimerLignes()
    ' Declaration  des variables (éléments permettant de stocker des valeurs temporaires)
    Dim strColonne As String   ' Variables contenant du texte
    Dim varValeurSupprimee As Variant    ' Variable pouvant contenir tout type de valeur
    Dim objCellule As Range    ' Variable objet representant un cellule
 
    ' Conversation avec l'utilisateur (inputBox pour entrer une valeur - MsgBox pour Afficher une information, un message destiné à l'utilisateur)
    strColonne = InputBox("Indiquer la colonne contenant les valeurs à supprimer")
    varValeurSupprimee = InputBox("indiquer la valeur à supprimer")
 
    ' Sélectionne la première cellule de la colonne demandée
    Range(strColonne & "1").Select
    ' Sélectionne l'ensemble des cellules de la colonne concernée
    Range(ActiveCell, ActiveCell.End(xlDown)).Select
 
    ' Consulte chacune des cellules sélectionnées
    For Each objCellule In Selection
        ' Teste pour vérifier si le contenu de la cellule en cours est équivalent au critère demandé plus haut. Attention : pour le texte, il y a une différence entre les majuscules et les minuscules)
        If objCellule = varValeurSupprimee Then
            ' Supprime la ligne si la valeur est trouvée
            objCellule.EntireRow.Delete
        End If
    Next
End Sub

Bon courage et bonne découverte du langage VBA

[Gorfael]

Salut eillon et le forum
autre solution

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
 
Sub test()
Dim Col As String
Dim Crit As Variant
Dim X As Long
Col = UCase(Application.InputBox("Colonne à controler ?", "Srppression de ligne", _
      "lettre(s) colonne", , , , , 2))
On Error Resume Next
If IsError(Range(Col & 1)) Then
    MsgBox "La valeur entrée n'est pas valide !", vbCritical + vbOKOnly, _
           "ERREUR DÉFINITION COLONNE"
    Exit Sub
End If
On Error GoTo 0
Crit = InputBox("Crttère de suppression ?", "Suppression de ligne")
If Crit = "" Then Exit Sub
For X = Range(Col & 65536).End(xlUp).Row To 1 Step -1
    If Cells(X, Col) = Crit Then Rows(X).Delete
Next X
End Sub

A+

[eillon]

Merci beaucoup pour votre aide, la macro de Gorfael me plait bien mais je ne peux pas supprimer de lignes si je rentre un chiffre..

Pour celle de Jeannot45, elle ne me supprime pas toutes les valeurs.

Est-il possible de ne pas prendre en compte la casse, car c'est pour supprimer des produits dans un fichiers avec le nom du fabricant, à savoir que les marques ont parfois leur nom avec des majuscules d'autre fois non (selon les fournisseurs qui envoie la liste).

[Gorfael]

Merci beaucoup pour votre aide, la macro de Gorfael me plait bien mais je ne peux pas supprimer de lignes si je rentre un chiffre..

Pour celle de Jeannot45, elle ne me supprime pas toutes les valeurs.

Est-il possible de ne pas prendre en compte la casse, car c'est pour supprimer des produits dans un fichiers avec le nom du fabricant, à savoir que les marques ont parfois leur nom avec des majuscules d'autre fois non (selon les fournisseurs qui envoie la liste).

Salut
Le problème de la casse est résolvable facilement en mettant les 2 cotés du test en majuscules :

Code :

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

If ucase(Cells(X, Col)) = ucase(Crit) Then

On peut aussi utiliser like avec les risques du à sa permissivité sur les accents,etc ;;;

Code :

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

If Cells(X, Col) like Crit Then

Quand je supprimes, je préfère être précis

Pour les nombres, on peut faire un test avant et définir la variable différemment :
après avoir récupéré Crit :

Code :

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

If isnumeric(Crit) then Crit=Cdbl(crit)

A+

[eillon]

Merci.

ça évite de courir après les majuscules...

Vous allez me trouver pénible, mais si je veux supprimer plusieurs référence différentes en une fois, peut-on les séparer par un ";" ?

[Gorfael]

Merci.

ça évite de courir après les majuscules...

Vous allez me trouver pénible, mais si je veux supprimer plusieurs référence différentes en une fois, peut-on les séparer par un ";" ?

Salut
Oui, on peut, mais il faut extraire les différente partie et les ranger dans un tableau Variant pour accepter les textes et doubles et les comparer à chaque cellule

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
30
31
32
33
34
35
36
37
38
39
40
41
42
 
Sub test()
Dim Col As String
Dim Crit() As Variant
Dim Rep As String
Dim X As Long
Dim Ind As Integer
Col = UCase(Application.InputBox("Colonne à controler ?", "Srppression de ligne", _
      "lettre(s) colonne", , , , , 2))
On Error Resume Next
If IsError(Range(Col & 1)) Then
    MsgBox "La valeur entrée n'est pas valide !", vbCritical + vbOKOnly, _
           "ERREUR DÉFINITION COLONNE"
    Exit Sub
End If
On Error GoTo 0
Rep = InputBox("Crttère de suppression ?", "Suppression de ligne")
ReDim Crit(0)
Do
    If InStr(1, Rep, ";") > 0 Then
        Crit(UBound(Crit)) = Trim(Left(Rep, InStr(1, Rep, ";") - 1))
        If IsNumeric(Crit(UBound(Crit))) Then Crit(UBound(Crit)) = CDbl(Crit(UBound(Crit)))
        If Len(Crit(UBound(Crit))) > 0 Then ReDim Preserve Crit(UBound(Crit) + 1)
        Rep = Right(Rep, Len(Rep) - InStr(1, Rep, ";"))
    Else
        Crit(UBound(Crit)) = Trim(Rep)
        If Len(Crit(UBound(Crit))) = 0 Then
            If UBound(Crit) = 0 Then Exit Sub
            ReDim Preserve Crit(UBound(Crit) - 1)
        End If
        Exit Do
    End If
Loop
For X = Range(Col & 65536).End(xlUp).Row To 1 Step -1
    For Ind = 0 To UBound(Crit)
        If UCase(Cells(X, Col)) = UCase(Crit(Ind)) Then
            Rows(X).Delete
            Exit For
        End If
    Next Ind
Next X
End Sub

J'avoue ne pas donner d'explications, mais si elles sont nécessaires je renseignerais mon code. Mais comme je suis feignant, je ne le donnerai que sur la macro finale, et si il y a des instructions que tu n'as pas compris.

Mais il est essentiel que tu comprennnes chaque instruction, pour pouvoir adapter et par ce qu'il est débile d'utiliser du code sans avoir une idée de ce qu'il fait

A+

[eillon]

En fait, je vous fait parvenir un fichier exemple, tout ce qui est en jaune doit être supprimer sur d'autres classeurs (lignes entières).

J'ai testé ça mais ça ne me supprime pas toutes les refs.

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
Sub coupe()
If MsgBox("ATTENTION, vous aller supprimer les lignes", vbExclamation + vbOKCancel + vbApplicationModal + 0, "Lionel") = vbOK Then
Dim i As Integer, j As Integer, DLV1 As Integer, DLV2 As Integer
 
DLV2 = Sheets(2).Columns(1).Find("", [A65536], , , xlByRows, xlPrevious).Row - 1
DLV1 = Sheets(1).Columns(1).Find("", [A65536], , , xlByRows, xlPrevious).Row - 1
 
For i = DLV1 To 1 Step -1
    For j = 1 To DLV2
        If Sheets(1).Range("A" & i).Value = Sheets(2).Range("A" & j).Value Then _
        Sheets(1).Rows(i).Delete
          Next j
Next i
End If
End Sub

[eillon]

J'ai modifier avec ça

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
30
Sub supprimer_Marques_Références()
 
If MsgBox("ATTENTION, vous aller supprimer les lignes du F U", vbExclamation + vbOKCancel + vbApplicationModal + 0, "Lionel") = vbOK Then
Dim i As Integer, j As Integer, DLV1 As Integer, DLV2 As Integer
 
        DLV2 = Sheets(2).Columns(1).Find("", [A65536], , , xlByRows, xlPrevious).Row - 1
        DLV1 = Sheets(1).Columns(2).Find("", [B65536], , , xlByRows, xlPrevious).Row - 1
 
For i = DLV1 To 1 Step -1
    For j = 1 To DLV2
        If Sheets(1).Range("B" & i).Value = Sheets(2).Range("A" & j).Value Then _
        Sheets(1).Rows(i).Delete
          Next j
    Next i
        DLV2 = Sheets(2).Columns(1).Find("", [A65536], , , xlByRows, xlPrevious).Row - 1
        DLV1 = Sheets(1).Columns(1).Find("", [A65536], , , xlByRows, xlPrevious).Row - 1
 
For i = DLV1 To 1 Step -1
    For j = 1 To DLV2
        If Sheets(1).Range("A" & i).Value = Sheets(2).Range("A" & j).Value Then _
        Sheets(1).Rows(i).Delete
          Next j
    Next i
End If
        derniereLigne = ActiveSheet.UsedRange.Rows.Count
        Application.ScreenUpdating = False
        For r = derniereLigne To 1 Step -1
        If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete
    Next r
End Sub

Mais ça ne me supprime que les données en colonnes A.
Et c'est super long sur 12000 lignes...

[eillon]

Voilà qui marche, c'est un peu long, mais je ferais avec...

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
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
Sub Supprimer_marques_références()
 
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
 
 
 Set MonDico1 = CreateObject("Scripting.Dictionary")
 
  If MsgBox("ATTENTION, vous aller supprimer les marques et references", vbExclamation + vbOKCancel + vbApplicationModal + 0, "Lionel") = vbOK Then
 
Dim i As Integer, J As Integer, DLV1 As Integer, DLV2 As Integer, DLV3 As Integer, DLV4 As Integer
 
        DLV2 = Sheets(2).Cells(65536, 1).End(xlUp).Row
        DLV1 = Sheets(1).Cells(65536, 1).End(xlUp).Row
 
For i = DLV1 To 1 Step -1
 
    For J = 1 To DLV2
 
    If Sheets(1).Range("A" & i).Value = Sheets(2).Range("A" & J).Value Then _
    Sheets(1).Rows(i).Delete
 
        Next J
    Next i
  Set mondico2 = CreateObject("Scripting.Dictionary")
  DLV4 = Sheets(2).Cells(65536, 2).End(xlUp).Row
        DLV3 = Sheets(1).Cells(65536, 2).End(xlUp).Row
 
For i = DLV3 To 1 Step -1
 
    For J = 1 To DLV4
 
        If Sheets(1).Range("B" & i).Value = Sheets(2).Range("B" & J).Value Then _
        Sheets(1).Rows(i).Delete
 
         Next J
    Next i
 
    End If
 
        derniereLigne = ActiveSheet.UsedRange.Rows.Count
        Application.ScreenUpdating = False
        For r = derniereLigne To 1 Step -1
        If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete
    Next r
 
 
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
 
 
End Sub