Problème VBA : suppression de lignes sous conditions multiples

**mia73** · 14/10/2012, 14h36

Bonjour,

Je sollicite votre aide aujourd'hui pour une macro sur laquelle je bloque depuis qlq jours.

Voici le contexte : mon fichier de travail copie automatiquement une feuille d'un autre classeur Excel grâce à une macro. Une fois les données importées dans mon fichier, je souhaite rajouter qlq lignes de code afin de supprimer les lignes qui ne m'intéressent pas.
Ces lignes sont repérables par une colonne "statut" : le but est de supprimer toutes les lignes dont le statut est "Client". Pour ce faire, après qlq recherches sur le forum voici le code que j'ai écris :

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
 Public Sub Test()
 
    Dim XLSheet As Excel.Worksheet
    Dim FirstCell As Excel.Range
    Dim LastCell As Excel.Range
    Dim CellsDel As Excel.Range
    Dim i As Integer
    Dim XlApp As Excel.Application
    Dim XlWbk As Excel.Workbook
 
    Set XlApp = Application.Application
    Set XlWbk = XlApp.ActiveWorkbook
    Set XLSheet = XlWbk.Worksheets("Feuil1")
 
    XLSheet.Activate
 
    Set FirstCell = XLSheet.Cells(3, 1)
    Set LastCell = XLSheet.Cells(20, 5)
 
    For i = LastCell.Row To FirstCell.Row Step -1
        If Cells(i, 3).Text = "Client" Then
            If CellsDel Is Nothing Then
            Set CellsDel = XLSheet.Cells(i, 3)
            Else
            Set CellsDel = Union(CellsDel, XLSheet.Cells(i, 3))
            End If
        End If
    Next i
    CellsDel.EntireRow.Delete Shift:=xlUp
 
End Sub

Ce code semble fonctionner (il bug juste lorsqu’il n’y pas de document « Client »). Mon problème est qu'il y a également dans mon fichier des lignes de titres, repérables par le statut "_t". Je souhaite supprimer les titres en-dessous desquels toutes les lignes ont un statut « Client » (sinon je me retrouve avec une succession de titres superflus). Et là je ne m’en sors plus !

Merci d’avance pour votre aide

Pour plus de clarté voici un exemple simplifié des données que je souhaite traiter avec la macro :

Intitulé	Statut
titre1		_t
nom_doc		Autre
nom_doc		Client
nom_doc		Client/Autre
titre2		_t
titre2.1	_t
nom_doc		Client
nom_doc		Client
titre2.2	_t
nom_doc		Client/Autre
nom_doc		Client
titre3		_t
titre3.1	_t
nom_doc		Client
nom_doc		Client
titre3.2	_t
nom_doc		Client

Après traitement je voudrais obtenir ceci :

Intitulé	Statut
titre1		_t
nom_doc		Autre
nom_doc		Client/Autre
titre2		_t
titre2.2	_t
nom_doc		Client/Autre

**patricktoulon** · 14/10/2012, 17h46

bonjour

essai un truc du genre

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
 
Sub suppression_des_lignes_superfu()
Dim cellule As Range
Dim celulo() As Variant
Dim i As Long, e As Long
    With Sheets(Feuil1).Range("a3:e20")
 
        Set cellule = .Find("client", LookIn:=xlValues)
        If Not c Is Nothing Then
            firstAddress = c.Address
            Do
                i = i + 1
               On Error Resume Next
                ReDim Preserve cellulo(1 To i)
                cellulo(i) = cellule.Address
                Set cellule = .FindNext(cellule)
            On Error GoTo 0
            Loop While Not c Is Nothing And c.Address <> first Address
        End If
    End With
 
    For e = 1 To i
       MsgBox "on trouve client dans la cellule " & cellule(e)
    Next
End Sub

je n'est pas tester mais ça doit pas être loin de ce que tu cherche
pour la suppression fait le dans la boucle "for e "
et pour la ligne de dessous chaque cellule client c'est range(cellulo(e)).offset(1,0)

au plaisir

**mia73** · 14/10/2012, 21h59

Merci pour le code.
Malheureusement je ne comprends pas très bien cette partie :

Code :

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

1
2
3
                ReDim Preserve cellulo(1 To i)
                cellulo(i) = cellule.Address
                Set cellule = .FindNext(cellule)

A quoi sert "cellulo" ?
Je comprends qu'il prend la valeur cellule.Address, mais je ne vois pas comment il est utilisé ensuite...

Voici ce que j'ai essayé de faire de mon coté (mais qui ne marche pas !).

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
 Public Sub Test()
 
    Dim XlApp As Excel.Application
    Dim XlWbk As Excel.Workbook
    Dim XLSheet As Excel.Worksheet
    Dim FirstCell As Excel.Range
    Dim LastCell As Excel.Range
    Dim CellsDel As Excel.Range
    Dim CellsDel2 As Excel.Range
    Dim i As Integer
 
    Set XlApp = Application.Application
    Set XlWbk = XlApp.ActiveWorkbook
    Set XLSheet = XlWbk.Worksheets("Feuil1")
 
    XLSheet.Activate
 
    Set FirstCell = XLSheet.Cells(3, 1)
    Set LastCell = XLSheet.Cells(24, 5)
 
    For i = LastCell.Row To FirstCell.Row Step -1
        If Cells(i, 3).Text = "Client" Then
            If CellsDel Is Nothing Then
            Set CellsDel = XLSheet.Cells(i, 3)
            Else
            Set CellsDel = Union(CellsDel, XLSheet.Cells(i, 3))
 
                If XLSheet.Cells(i - 1, 3).Text = "_t" Then
                CellsDel.EntireRow.Delete Shift:=xlUp
                Set LastCell = XLSheet.Cells.Range("A65536").End(xlUp)
                ' ne faudrait-il pas redimensionner la zone de travail (ReDim ?)
                    If XLSheet.Cells(i, 3).Text = "_t" Or _
                        XLSheet.Cells(i, 3) = "" Then
                        If CellsDel2 Is Nothing Then
                        Set CellsDel2 = XLSheet.Cells(i - 1, 3)
                        Else
                        Set CellsDel2 = Union(CellsDel2, XLSheet.Cells(i - 1, 3))
                        End If
                    'il manque aussi une condition pour prendre en compte le niveau du titre (2, 2.1, etc).
                    Else
                    Set CellsDel2 = Nothing
                    End If
                End If
 
            End If
        End If
    Next i
    CellsDel.EntireRow.Delete Shift:=xlUp
    CellsDel2.EntireRow.Delete Shift:=xlUp
 
End Sub

Ce sera peut-être plus clair avec le fichier : http://cjoint.com/?0Jov3U0RBiZ

**patricktoulon** · 15/10/2012, 13h04

Envoyé par mia73

Merci pour le code.
Malheureusement je ne comprends pas très bien cette partie :

Code :

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

1
2
3
                ReDim Preserve cellulo(1 To i)
                cellulo(i) = cellule.Address
                Set cellule = .FindNext(cellule)

A quoi sert "cellulo" ?
Je comprends qu'il prend la valeur cellule.Address, mais je ne vois pas comment il est utilisé ensuite...

cette partie sert a mémoriser les cellules qui ont "client" on ne peut pas supprimer directement la ligne dans la boucle "with en with" sinon au prochain tour il y aurai une erreur puisque cellule devient a chaque fois le cellule trouvée avec "client " si tu la supprime dans le with.... au prochain bouclage cellule n'existe plus alors find next est vide

pour comprendre le shema essaie ceci
a la place de redim preserve ........ dans la boucle with end with

Code :

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

liste=liste & vbcrlf & cellule .address

et après le do loop
met

Code :

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

 msgbox liste

au plaisir

**mia73** · 17/10/2012, 19h42

Merci pour l'explication, je comprends mieux.

Finalement j'ai réussi à faire marcher ma macro de ci-dessus en changeant quelques parties.

Mais à l'occasion j'essaierai de la refaire avec ta méthode Patrick !

Problème VBA : suppression de lignes sous conditions multiples

Macros et VBA Excel

Discussions similaires

Partager

Partager