Amélioration / Correction macro

Version imprimable

1 pièce(s) jointe(s)

Bonjour,

J'ai codé la macro suivante, mais j'aimerai améliorer la syntaxe du code et surtout des boucles car le fichier original contient beaucoup de données ce qui ralentit le traitement.

Si les HardCoderz du forum peuvent y apporter des corrections/améliorations, tout en m'expliquant pourquoi, je suis preneur !

Comment ce code doit marcher ?
1) Dans le sheet "Feuil1" j'ai des données de la colonne A à P (P contient une référence unique pour chaque ligne)

2) Dans "Feuil2" je copie des données de la colonne A à N (N contient une référence unique pour chaque ligne)

3)je lance le code

==> Dans "Feuil2" il y a des références que l'on retrouve dans "Feuil1". La macro a pour but de supprimer les références de la colonne N dans ""Feuil2" qui sont déjà présentent dans "Feuil1".

Merci et j'attends vos feedback

Cheers !
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 Sub test_ctrl1() '**** declaration des variables **** Dim I As Integer Dim ref_deal As String Application.ScreenUpdating = False '**** scan et delete des references **** For I = 2 To 40 Step 1 ref_deal = Worksheets("Feuil2").Cells(I, 14) Set MonDeal = Worksheets("Feuil1").Range("P2:P3000").Find(ref_deal, LookIn:=xlValues) If Not MonDeal Is Nothing Then Worksheets("Feuil2").Range("N2:N40").Find(ref_deal, LookIn:=xlValues).EntireRow.Delete 'j'aimerai supprimer la ligne correspondante que de la colonne A à N If I = 40 Then Exit For Next I Set MonDeal = Nothing For I = 2 To 20 Step 1 ref_deal = Worksheets("Feuil2").Cells(I, 14) Set MonDeal = Worksheets("Feuil1").Range("P2:P3000").Find(ref_deal, LookIn:=xlValues) If Not MonDeal Is Nothing Then Worksheets("Feuil2").Range("N2:N21").Find(ref_deal, LookIn:=xlValues).EntireRow.Delete 'supprimer la ligne correspondante que de la colonne A à N If I = 20 Then Exit For Next I Set MonDeal = Nothing For I = 2 To 15 Step 1 ref_deal = Worksheets("Feuil2").Cells(I, 14) Set MonDeal = Worksheets("Feuil1").Range("P2:P3000").Find(ref_deal, LookIn:=xlValues) If Not MonDeal Is Nothing Then Worksheets("Feuil2").Range("N2:N20").Find(ref_deal, LookIn:=xlValues).EntireRow.Delete 'supprimer la ligne correspondante que de la colonne A à N Next I MsgBox ("Le traitement est terminé") End Sub

Code:

1
2
3
4
5
6
For I = 2 To 40 Step 1
ref_deal = Worksheets("Feuil2").Cells(I, 14)
Set MonDeal = Worksheets("Feuil1").Range("P2:P3000").Find(ref_deal, LookIn:=xlValues)
If Not MonDeal Is Nothing Then Worksheets("Feuil2").Range("N2:N40").Find(ref_deal, LookIn:=xlValues).EntireRow.Delete 'j'aimerai supprimer la ligne correspondante que de la colonne A à N
If I = 40 Then Exit For
Next I

Ton code devrait bien être réduit... Par contre il m'a l'air bien inutile aussi, si le refdeal est écrit plusieurs fois il ne sera supprimé qu'une fois

Par contre tes autres boucles... font la même chose.. je ne comprends pas pouirquoi

Code:

1
2
3
4
On error resume next
For I = 2 To 40
Worksheets("Feuil1").Range("P2:P3000").Find(Worksheets("Feuil2").Cells(I, 14), LookIn:=xlValues).EntireRow.Delete
Next I

heu

bonjour
puisque tu travaille sur des grands nombres de lignes tu devrais essayer de travailler avec des variables tableaux voir de dictionnaires
a mediter

un peu comme ceci

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
 
Sub tri()
    Dim tablofinal(3000, 16) 'un tablofinale prevu pour comporter 300ligne et 16 colonnes
    Dim tabloatrié, tablobase 'les deux tablo a comparer
    tablobase = Sheets("Feuil2").Range("n2:n40") 'les argument de comparaison seront dans ce tablo
    tabloatrié = Sheets("Feuil1").Range("a2:P3000") 'ce tablo represent la feuil1 sur 3000 ligne et 16 colonne
    For i = LBound(tablobase) To UBound(tablobase) 'on boucle sur les 40 lignes du tablobase
        For e = LBound(tabloatrié) To UBound(tabloatrié) 'on boucle sur les 3000 lignes du tabla a trier
            If tabloatrié(e, 16) <> tablobase(i) Then 'on compare chaque lignes du tablobase a a chaque ligne du tabloatrié en colonne 16
                a = a + 1
                For Z = 1 To 16
                    tablofinal(a, Z) = tabloatrié(e, Z) 'on retranscrit les données du tabloatrié dans le tablofinal si la colonne 16 ne corespond pas a l'index du tablobase
                Next Z
            Next i
        Next e
Sheets("Feuil1").Range("a2:p3000") = "" 'on efface tout sur le sheet feuil1 a partir de a2
Sheets("Feuil1").Range("a2").Resize(3000, 16) = tablofinal ' on recalque les donnée du tablo final sur le sheets feuil1 sans les indesirables du tablode base
End Sub

au plaisir

Bonjour,

Merci pour vos réponses constructives.

@patricktoulon
Ton explication m'a permise de découvrir de nouvelle fonction ! je la garde sous la souris :)
Cependant, je ne comprends pas tout et le traitement est un peu trop complexe par rapport à mon réel besoin...

@EngueEngue

Quelle est la différence entre : (+ rapide ? - d'octets ?...???)
Code:

1 2 3 4 5 6 7 For I = 2 To 40 Step 1 ref_deal = Worksheets("Feuil2").Cells(I, 14) Set MonDeal = Worksheets("Feuil1").Range("P2:P3000").Find(ref_deal, LookIn:=xlValues) If Not MonDeal Is Nothing Then Worksheets("Feuil2").Range("N2:N40").Find(ref_deal, LookIn:=xlValues).EntireRow.Delete 'j'aimerai supprimer la ligne correspondante que de la colonne A à N If I = 40 Then Exit For Next I
et
Code:

1 2 3 4 5 On error resume next For I = 2 To 40 Worksheets("Feuil1").Range("P2:P3000").Find(Worksheets("Feuil2").Cells(I, 14), LookIn:=xlValues).EntireRow.Delete Next I
Citation:

Par contre tes autres boucles... font la même chose.. je ne comprends pas pouirquoi

Avec la V1 du code (cf. premier poste) si "ref_deal" était trouvé, la ligne était supprimée ce qui faisait tout décaler de +1.

Exemple:
Pour I = 4
- la "ref_deal" en N4 de "feuil2" est trouvée dans "feuil1"
- La ligne entière de "feuil2" est supprimée
===> la "ref_deal" en N5 devient N4 !
======> je loupe donc une ligne !

Pour remédier à cela j'ai juste fait une boucle en sens inverse :

Par contre, j'aimerai que :

If Not MonDeal Is Nothing Then Worksheets("Feuil2").Range("N2:N40").Find(ref_deal, LookIn:=xlValues).EntireRow.Delete

ne supprime pas toute les colonnes de la ligne mais uniquement celles de A à N pour la ligne correspondante à "ref_deal"

Pouvez-vous m'aider svp ?
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 Sub test_ctrl1() '**** declaration des variables **** Dim I As Integer Dim ref_deal As String Application.ScreenUpdating = False '**** scan et delete des references **** For I = 2 To 40 Step 1 ref_deal = Worksheets("Feuil2").Cells(I, 14) Set MonDeal = Worksheets("Feuil1").Range("P2:P3000").Find(ref_deal, LookIn:=xlValues) If Not MonDeal Is Nothing Then Worksheets("Feuil2").Range("N2:N40").Find(ref_deal, LookIn:=xlValues).EntireRow.Delete 'supprimer la ligne correspondante que de la colonne A à N If I = 40 Then Exit For Next I Set MonDeal = Nothing For I = 40 To 2 Step -1 ref_deal = Worksheets("Feuil2").Cells(I, 14) Set MonDeal = Worksheets("Feuil1").Range("P2:P3000").Find(ref_deal, LookIn:=xlValues) If Not MonDeal Is Nothing Then Worksheets("Feuil2").Range("N21:N2").Find(ref_deal, LookIn:=xlValues).EntireRow.Delete 'supprimer la ligne correspondante que de la colonne A à N If I = 2 Then Exit For Next I Set MonDeal = Nothing MsgBox ("Le traitement est terminé") End Sub

Une autre proposition.

Le code met en colonne O la formule =NB.SI(Feuil1!$P$2:$P$xxx;$N2)
Filtre cette colonne sur les valeurs <>0
Supprime les lignes visibles
Supprime le filtre automatique
Efface le reste de la colonne O

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
Sub Test()
Dim N As Long, M As Long
Dim Lignes As Range
 
Application.ScreenUpdating = False
With Feuil1
    N = .Cells(.Rows.Count, "P").End(xlUp).Row
End With
 
With Feuil2
    .AutoFilterMode = False
    M = .Cells(.Rows.Count, "N").End(xlUp).Row
 
    With .Range("O1:O" & M)
        .Formula = "=COUNTIF(Feuil1!$P$2:$P$" & N & ",$N1)"
        .AutoFilter Field:=1, Criteria1:="<>0"
    End With
    With .AutoFilter.Range
        On Error Resume Next
        Set Lignes = .Offset(1, 0).Resize(.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible).EntireRow 'On peut enlever le Resize si on la ligne après tes données est vide et peut être aussi supprimée
        On Error GoTo 0
    End With
    If Not Lignes Is Nothing Then Lignes.Delete
    .AutoFilterMode = False
    .Range("O1:O" & M).ClearContents
End With
End Sub

06/09/2013, 12h08
patricktoulon

re

Bonjour

Citation:

Par contre, j'aimerai que :

If Not MonDeal Is Nothing Then Worksheets("Feuil2").Range("N2:N40").Find(ref_deal, LookIn:=xlValues).EntireRow.Delete

ne supprime pas toute les colonnes de la ligne mais uniquement celles de A à N pour la ligne correspondante à "ref_deal"

Pouvez-vous m'aider svp ?

"EntireRow.Delete "supprime la ligne complete
pour effacer rien que la plage A a N il te faut recupere l'index de ligne par le find
et

Code:

If Not MonDeal Is Nothing Then range("a" & MonDeal.row &":N" & MonDeal.row).clear

Au plaisir

Bonjour Patrick,

Merci pour ton retour qui m'a permis de mettre un bouton sans qu'il soit supprimé (emntre autre).

Pour info, je n'ai maintenant plus qu'une boucle a laquelle j'ai rajouté une supression des lignes vides.

Bon week end a tous !
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 For I = 2 To 200 Step 1 ref_deal = Worksheets("Feuil3").Cells(I, 14) Set MonDeal = Worksheets("Feuil1").Columns("P").Find(ref_deal, LookIn:=xlValues) If Not MonDeal Is Nothing Then Worksheets("Feuil3").Range("A" & I & ":N" & I).Clear Next I Set MonDeal = Nothing '**** Suppression des lignes vides **** For I = Range("A40").End(xlUp).Row To 2 Step -1 If Application.CountA(Rows(I)) = "0" Then Worksheets("Feuil3").Range("A" & I & ":N" & I).Delete Next I