Discussion :

[midge]

Bonjour au forum
Ci-après une macro créee à l'aide des discussions DVP.com
Ce sont 2 boucles qui font le ménage (lignes et colonnes indésirables dans l'analyse ultérieure de la feuille). Comme les pros le constateront, l'écriture de la macro prend du temps.
Ma question : y-a-t-il moyen de faire plus court pour arriver au même résultat et ne faire qu'une macro au lieu de 2 ?
Je précise que les lignes (noms de personnes) n'ont pas de lien causal avec les colonnes (noms d'activités), que la feuille peut être de taille différente (lignes et colonnes changent selon les mois)

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
53
54
55
56
57
58
59
60
61
62
 
Option Explicit
Sub SupprimerL()
 
 Dim I As Long
 Dim NbLig As Long
 
 Application.ScreenUpdating = False
 
 
 With Worksheets("Essai")
 
 NbLig = .Cells(.Rows.Count, 1).End(xlUp).Row
 
 
                For I = NbLig To 1 Step -1
 
 
 
                If .Cells(I, 1) Like "DUBOIS" Or .Cells(I, 1) Like "DUCHIEN VIRGINIE" Or .Cells(I, 1) Like "DUDIT PASCAL" _
                Or .Cells(I, 1) Like "DUFLOT VALERIE" Or .Cells(I, 1) Like "DUEZ ALAIN" Or .Cells(I, 1) Like "DUGONNEAU ERICK" _
                Or .Cells(I, 1) Like "DUHON MYLENE" Or .Cells(I, 1) Like "DUISSEAU FREDERIC" Or .Cells(I, 1) Like "DULLIX CELIK" _
                Or .Cells(I, 1) Like "DUPRE MARIE JOSEE" Or .Cells(I, 1) Like "DUROC THOMAS " Then
 
                .Cells(I, 1).EntireRow.Delete
 
                End If
 
        Next I
 
End With
 
Application.ScreenUpdating = True
 
End Sub
____________________________________________________________________________________________________________________
Sub SupprimerC()
 
Dim J As Long
Dim NbCol As Long
 
Application.ScreenUpdating = False
 
With Worksheets("Essai")
 
NbCol = .Cells(3, Columns.Count).End(xlToLeft).Column
 
                For J = NbCol To 1 Step -1
 
                If .Cells(3, J) Like "AIDE" Or .Cells(3, J) Like "AIRE" Or .Cells(3, J) Like "DOL" Or .Cells(3, J) Like "ETTI" Or .Cells(3, J) Like "VAGVD" _
                Or .Cells(3, J) Like "IRRE" Or .Cells(3, J) Like "RSST" Or .Cells(3, J) Like "RRDE" Or .Cells(3, J) Like "EFDD" Or .Cells(3, J) Like "PELT" _
                Or .Cells(3, J) Like "MAGE" Or .Cells(3, J) Like "SIPA" Or .Cells(3, J) Like "PREA" Or .Cells(3, J) Like "PARA" Or .Cells(3, J) Like "AMAT" _
                Or .Cells(3, J) Like "BCO" Or .Cells(3, J) Like "DCDE" Or .Cells(3, J) Like "FIN" Or .Cells(3, J) Like "JAIF" Or .Cells(3, J) Like "MUST" Then
 
                .Cells(3, J).EntireColumn.Delete
 
                End If
 
        Next J
 
End With
End Sub

Merci d'avance pour vos idées et/ou propositions

[gFZT82]

Bonjour,

Une variante

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
Option Explicit
Sub SupprimerLC()
Dim TabloCol, TabloLig
Dim I As Long
Dim Lig As Range, Col As Range
    Application.ScreenUpdating = False
    With Worksheets("Essai")
        TabloCol = Array("DUBOIS", "DUCHIEN VIRGINIE", "DUDIT PASCAL", "DUFLOT VALERIE", "DUEZ ALAIN", "DUGONNEAU ERICK", "DUHON MYLENE", "DUISSEAU FREDERIC", "DULLIX CELIK", "DUPRE MARIE JOSEE", "DUROC THOMAS")
        TabloLig = Array("AIDE", "AIRE", "DOL", "ETTI", "VAGVD", "IRRE", "RSST", "RRDE", "EFDD", "PELT", "MAGE", "SIPA", "PREA", "PARA", "AMAT", "BCO", "DCDE", "FIN", "JAIF", "MUST")
        For I = 0 To UBound(TabloCol)
            Set Lig = .Columns(1).Find(TabloCol(I), LookAt:=xlPart)
            If Not Lig Is Nothing Then
                Lig.EntireRow.Delete
            End If
        Next I
        For I = 0 To UBound(TabloLig)
            Set Col = .Rows(3).Find(TabloLig(I), LookAt:=xlPart)
            If Not Col Is Nothing Then
                Col.EntireColumn.Delete
            End If
        Next I
    End With
    Application.ScreenUpdating = True
End Sub

Cordialement.

[midge]

@ gFZT82
Merci pour ce code qui fonctionne à merveille !
Reste à le comprendre dans sa totalité ...