Discussion :

[nhug1]

Bonjour messieurs et mesdames,

Je me permets de vous déranger quelques instants pour des petits conseils.

Pour commencer, je suis actuellement en stage dans un établissement Bancaire et je me suis mis en tête de faire un petit programme VBA.

Le programme:

Ce dernier "devrait" simplement permettre de supprimer des lignes en fonction d'un critère choisi par l'utilisateur dans un input box. (a posteriori il permettra également d'en extraire des données).

Le tableau sur lequel il doit opérer:

des colonnes qui vont jusqu'à "AQ", plus de 22000 lignes et malheureusement... confidentiel.

Le(s) problème(s):

1°) N'étant pas très très à l'aise avec VBA, je fais ce que je peux avec ce que j'ai!
2°) Mon VRAI problème est que mon programme n'a l'air de s'exécuter que sur les premières colonne du programme
3°) j'ai beaucoup trainé sur developpez.net sans vraiment trouver réponse à ma question

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
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
 
Dim Trouve As Range, PlageDeRecherche As Range
Dim Valeur_Cherchee As String, AdresseTrouvee As String
Dim dercellule_de_lacolonne, I As Integer
 
'Permet de trouver la dernière cellule active de la feuille
adresseabsolue = Range("A1").SpecialCells(xlCellTypeLastCell).Address
 
'assigne l'input à Valeur_recherchée
Valeur_Cherchee = inputbox("critère? ")
 
'créer une plage de recherche sur toute les données active de la feuille de calcul
Set PlageDeRecherche = Range("A1", adresseabsolue)
 
'initialise la routine de recherche dans la place de recherche avec comme critère
'valeur_recherchee
Set Trouve = PlageDeRecherche.Cells.Find(what:=Valeur_Cherchee, LookAt:=xlWhole)
 
 
If Trouve Is Nothing Then
 
    AdresseTrouvee = Valeur_Cherchee & " n'est pas présent dans " & PlageDeRecherche.Address
Else
 
    Set colonne = Trouve.EntireColumn
 
    MsgBox colonne.Address
' problème si cellule vide, ne vas pas jusqu'au bout
 
 
'choisi la colonne comme range
For I = colonne.End(xlDown).Row To 1 Step -1
'ligne permettant de supprimer chaque ligne contenant le critère
'spécifié
 If Not Cells(I, 1).Resize(1, 6).Find(Valeur_Cherchee) Is Nothing Then Rows(I).Delete
Next I
 
End If
Application.ScreenUpdating = True
 
Set PlageDeRecherche = Nothing
Set Trouve = Nothing
End Sub

Je suis ouvert à tout tuyaux, optimisation, grosse fessée si j'ai fait des erreurs stupides, conseils etc!

PS: Les msgbox sont là pour savoir si ça coince quelque part, si cela vous embête je les enlève.

[Theze]

Bonjour,

Teste ce code :

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
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
 
Private Sub CommandButton1_Click()
 
    Dim Tbl() As Long
    Dim Trouve As Range
    Dim PlageDeRecherche As Range
    Dim Valeur_Cherchee As String
    Dim Adr As String
    Dim I As Long
    Dim J As Long
    Dim Tempo As Long
 
    'Permet de trouver la dernière cellule active de la feuille
 
 
    'assigne l'input à Valeur_recherchée
    Valeur_Cherchee = InputBox("Critère ?")
 
    If Valeur_Cherchee = "" Then Exit Sub
 
 
    'Attention !!! ce que retourne "SpecialCells(xlCellTypeLastCell)" est parfois surprenant et donc à utiliser avec parcimonie !
    'AdresseAbsolue = Range("A1").SpecialCells(xlCellTypeLastCell).Address
 
    'il est préférable d'utiliser la fonction Find comme ci-dessous !!!
    'créer une plage de recherche sur toute les données active de la feuille de calcul
    With ActiveSheet
 
        Set PlageDeRecherche = .Range(.Cells(1, 1), .Cells( _
                                      .Cells.Find("*", .Cells(1, 1), -4123, , 1, 2).Row, _
                                      .Cells.Find("*", .Cells(1, 1), -4123, , 2, 2).Column))
 
    End With
 
    'initialise la routine de recherche dans la place de recherche avec comme critère "Valeur_Cherchee"
    Set Trouve = PlageDeRecherche.Find(Valeur_Cherchee, , xlValues, xlWhole)
 
    If Trouve Is Nothing Then
 
        MsgBox "'" & Valeur_Cherchee & "' n'est pas présent dans " & PlageDeRecherche.Address(0, 0)
 
    Else
 
        'mémorise l'adresse de la 1ère cellule
        Adr = Trouve.Address
 
        'boucle pour récupérer les numéros de ligne dans le tableau
        Do
 
            I = I + 1
 
            ReDim Preserve Tbl(1 To I)
 
            Tbl(I) = Trouve.Row
 
            Set Trouve = PlageDeRecherche.FindNext(Trouve)
 
        Loop While Adr <> Trouve.Address
 
        'effectue un tri décroissant dans le tableau pour une suppression par le bas de la feuille
        For I = 1 To UBound(Tbl) - 1
 
            For J = I + 1 To UBound(Tbl)
 
                If Tbl(I) < Tbl(J) Then Tempo = Tbl(J): Tbl(J) = Tbl(I): Tbl(I) = Tempo
 
        Next J, I
 
        Application.ScreenUpdating = False
 
        For I = 1 To UBound(Tbl): Rows(Tbl(I)).EntireRow.Delete: Next I
 
        Application.ScreenUpdating = True
 
    End If
 
End Sub

Comme dit dans le code, "SpecialCells(xlCellTypeLastCell)" tout comme "UsedRange" sont à utiliser avec parcimonie car ils retournent souvent un Range qui peut surprendre.

[nhug1]

Theze, cher Theze...

Je ne sais pas vraiment comment te remercier du temps que tu as passé pour résoudre mon problème. Il faut également mettre en exergue que ta solution en plus d'être totalement fonctionnelle (testée avec mon fichier ce matin) est vraiment intelligente. Merci. Merci. Merci.


maintenant j'aimerai comprendre deux trois petites choses:

1°) Si j'ai bien saisi tu viens stocker dans un tableau les adresses des cellules qui contiennent le mot clé.
2°) Je n'ai pas réussi à saisir comment fonctionne ces lignes là:

Code :

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

1
2
3
4
5
6
7
For I = 1 To UBound(Tbl) - 1
 
            For J = I + 1 To UBound(Tbl)
 
                If Tbl(I) < Tbl(J) Then Tempo = Tbl(J): Tbl(J) = Tbl(I): Tbl(I) = Tempo
 
        Next J, I

notamment à quoi sert la variable tempo!

[Theze]

Bonjour,

J'ai écris le code de cette façon pour réduire un peu le nombre de lignes (le code restant relativement simple à interpréter) mais il peut s'écrire de façon plus "académique" comme ci-dessous (explications de la variable Tempo dans le code) :

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
 
For I = 1 To UBound(Tbl) - 1 'de 1 à la dimension max - 1
 
    For J = I + 1 To UBound(Tbl) 'de 2 à la dimension max
 
        'si Tbl(I) est inférieur à Tbl(J) J = I + 1 donc, si la dimension n est inférieure à la dimension n+1 on déplace les valeurs
        If Tbl(I) < Tbl(J) Then
 
            Tempo = Tbl(J) 'on stocke momentanément la valeur de Tbl(J) dans la variable
            Tbl(J) = Tbl(I) 'on affecte à Tbl(J) la valeur de la dimension précédente Tbl(I) puisqu'on veut un tri décroissant
            Tbl(I) = Tempo 'et on déplace dans Tbl(I) la valeur qui était dans Tbl(J) qui a été stockée dans la variable
 
        End If
 
    Next J
 
Next I

[nhug1]

Encore une fois, merci!!

J'ai créé un environnement avec des userforms pour pouvoir exécuter plusieurs opération avec le code
=> Supprimer ligne par critère spécifié par l'user
=> J'ai rajouté un tout petit bout à la ligne permettant de supprimer la ligne pour la transformer en copie vers une autre feuille (il faut que je règle le cas où la feuil2 n'existe pas et donc la créer

Code :

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

1
2
3
4
5
6
 
 For I = 1 To UBound(Tbl)
 
                        Rows(Tbl(I)).EntireRow.Copy Destination:=Worksheets("feuil2").[A1].Offset(I, 0):
 
        Next I

Grâce à tes explications dans le code, j'arrive à comprendre et à reproduire ta manière de fonctionner (ce qui m'est extrêmement utile!)

Maintenant je travaille sur l'implémentation de nouvelles fonctions:

1°) l'export des lignes vers un autre document excel (que je viens créer via VBA). J'y travaille dès que j'ai le temps et je le mettrais ici quand j'aurais un code potable
2°) Créer une copie de sauvegarde du fichier source dans le même répertoire que ce dernier
3°) Si le fichier excel contient plusieurs feuilles avec plusieurs tableaux alors l'user peut choisir sur quel tableau il veut faire l'action
4°) Pouvoir masquer le classeur vierge qui contient mon programme (Comme mon programme est dans un classeur sa première action est de venir ouvrir le classeur dans lequel on vient faire les actions
5°) mettre à disposition une fonction "Ctrl + Z" au cas où l'user se serait ravisé


Cela va me permettre d'appréhender un peu mieux VBA

[nhug1]

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
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
Private Sub CommandButton2_Click()
 
    Dim Tbl() As Long
    Dim Trouve As Range
    Dim PlageDeRecherche As Range
    Dim Valeur_Cherchee As String
    Dim Adr As String
    Dim I As Long
    Dim J As Long
    Dim Tempo As Long
    Dim V As Long
    Dim workbook_source As String
    Dim nom_de_la_feuille_active As String
 
 
    Chemin = ThisWorkbook.Path & "\"
    workbook_source = ActiveWorkbook.Name
    nom_de_la_feuille_active = ActiveSheet.Name
 
 
    'assigne l'input à Valeur_recherchée
    Valeur_Cherchee = inputbox("Critère ?")
 
    If Valeur_Cherchee = "" Then Exit Sub
 
 
 
    'créer une plage de recherche sur toute les données active de la feuille de calcul
    With ActiveSheet
 
        Set PlageDeRecherche = .Range(.Cells(1, 1), .Cells( _
                                      .Cells.Find("*", .Cells(1, 1), -4123, , 1, 2).Row, _
                                      .Cells.Find("*", .Cells(1, 1), -4123, , 2, 2).Column))
 
    End With
 
    'initialise la routine de recherche dans la place de recherche avec comme critère "Valeur_Cherchee"
    Set Trouve = PlageDeRecherche.Find(Valeur_Cherchee, , xlValues, xlWhole)
 
    If Trouve Is Nothing Then
 
        MsgBox "'" & Valeur_Cherchee & "' n'est pas présent dans " & PlageDeRecherche.Address(0, 0)
 
    Else
 
        'mémorise l'adresse de la 1ère cellule
        Adr = Trouve.Address
 
        'boucle pour récupérer les numéros de ligne dans le tableau
        Do
 
            I = I + 1
 
            ReDim Preserve Tbl(1 To I)
 
            Tbl(I) = Trouve.Row
 
            Set Trouve = PlageDeRecherche.FindNext(Trouve)
 
        Loop While Adr <> Trouve.Address
 
        'effectue un tri décroissant dans le tableau pour une suppression par le bas de la feuille
        For I = 1 To UBound(Tbl) - 1 'de 1 à la dimension max - 1
 
    For J = I + 1 To UBound(Tbl) 'de 2 à la dimension max
 
        'si Tbl(I) est inférieur à Tbl(J) J = I + 1 donc, si la dimension n est inférieure à la dimension n+1 on déplace les valeurs
        If Tbl(I) < Tbl(J) Then
 
            Tempo = Tbl(J) 'on stocke momentanément la valeur de Tbl(J) dans la variable
            Tbl(J) = Tbl(I) 'on affecte à Tbl(J) la valeur de la dimension précédente Tbl(I) puisqu'on veut un tri décroissant
            Tbl(I) = Tempo 'et on déplace dans Tbl(I) la valeur qui était dans Tbl(J) qui a été stockée dans la variable
 
        End If
 
    Next J
 
Next I
 
 
 
    Application.ScreenUpdating = False
 
        Set Workbook = Application.Workbooks.Add
 
        With Workbook
            .SaveAs Filename:=Chemin & Valeur_Cherchee
 
            nom_du_workbook = ActiveWorkbook.Name
 
            Set Workbook = ActiveWorkbook
 
            For I = 1 To UBound(Tbl)
 
                    Workbooks(workbook_source).Sheets(1).Rows(Tbl(I)).EntireRow.Copy Destination:=Workbooks(nom_du_workbook).Sheets(1).[A1].Offset(I, 0):
 
            Next I
 
 
 
        End With
 
 
 
 
    Application.ScreenUpdating = True
 
 
    End If
 
End Sub

J'ai réussi à adapter le code que tu m'as montré pour créer une fonction de copie vers un nouveau classeur! Bon j'avoue que j'ai pas mal lutté mais j'ai la satisfaction de l'avoir trouvé tout seul Mon seul petit soucis est que la copie vers le fichier cible ne commence pas en A1 mais ça je pense que ça ne me prendra pas super longtemps à trouver.