Discussion :

[Yolak]

Bonjour à tous et merci de me lire!
Voilà, j'ai pondu un code en vba qui fait plein de chose mais mon problème c'est qu'il est un peu trop lent.
Je vous explique:
Mon code doit traiter plus de 2000 fichiers à la suite (il retire des lignes, reclasses les colonnes,...). J'ai essayé d'optimiser moi-même mais je me demande si on ne pourrais pas mieux faire.
Ce que je vous demande, c'est votre avis!
Voici 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
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
Public Sub Suppression_doublons()
 
    'Les déclarations des variables
    Dim sNumTel As String, sNom As String, sAdd As String, iCP As String
    Dim iNb_Lignes As Integer
    Dim rCible As Range, iLigne As Integer, rRgeA As Range, rRgeB As Range
 
    'initialisation des variables
    iPos1 = 0
    iPos2 = 0
    iNb_Lignes = ActiveSheet.UsedRange.Rows.Count
 
        'Boucle sur toutes les lignes du fichier
        For i = 1 To iNb_Lignes Step 1
 
 
            'On en profite pour faire le transfert des numéros de mobile de la colonne "fixe" vers la colonne "mobile"
            '#####################################
            If Left(Range("E" & i).Value, 2) = "06" Then
                If Range("G" & i).Value = "" Then
                    Range("E" & i).Cut
                    Range("G" & i).Select
                    ActiveSheet.Paste
                Else
                    Range("E" & i).Select
                    Selection.ClearContents
                End If
            End If
 
            'On en profite pour faire la Suppression des parasites symbolisés par "-" dans la colonne B
            '#####################################
            'Dans la colonne B, on ne veut garder que les données se trouvant APRES le dernier tiret
            sChaine = Range("B" & i).Value
            iPos1 = InStr(sChaine, "-")
            If iPos1 <> 0 Then
                iPos2 = InStr(iPos1 + 1, sChaine, "-")
                If iPos2 <> 0 Then
                    iPos1 = iPos2
                End If
                sChaine = Right(sChaine, Len(sChaine) - 1 - iPos1)
                Range("B" & i).Value = sChaine
            End If
 
            'Suppression des doublons
            '#####################################
 
            sNumTel = Range("E" & i).Value
            sNom = Range("A" & i).Value
            iCP = Range("C" & i).Value
            sAdd = Range("B" & i).Value
 
 
            If sNumTel <> "" Then
 
 
               Set rCible = Range("E" & i + 1 & ":E" & iNb_Lignes).Find(what:=sNumTel, lookat:=xlWhole)
               If Not rCible Is Nothing Then
                   iLigne = rCible.Row
 
                   'On supprime un doublons uniquement si les colonnes A,B et C sont identiques
                   If Range("A" & iLigne) = sNom Then
                      If Range("B" & iLigne) = sAdd Then
                        If Range("C" & iLigne) = iCP Then
                            rRgeA = Range("A" & i & ":K" & i)
                            rRgeB = Range("A" & iLigne & ":K" & iLigne)
 
                            'La fonction "Compter_champs_non_vides compte le nombre de colonne non vide dans le range mit en paramètre.
                            'La ligne contenant le plus de colonne vide est supprimée
                            If Compter_champs_non_vide(rRgeA) > Compter_champs_non_vide(rRgeB) Then
                                Range("A" & iLigne).EntireRow.Delete
                                i = i - 1
                                iNb_Lignes = ActiveSheet.UsedRange.Rows.Count
                            ElseIf i <> iLigne Then
                                Range("A" & i).EntireRow.Delete
                                i = i - 1
                                iNb_Lignes = ActiveSheet.UsedRange.Rows.Count
                            End If
                        End If
                    End If
                   End If
               End If
            End If
 
    Next i
 
End Sub
 
Function Compter_champs_non_vide(rCible As Range) As Integer
    Dim Cellules As Range
    Compter_champs_non_vide = 0
    For Each Cellules In rCible
        If Cellules.Text <> "" Then
            Compter_champs_non_vide = Compter_champs_non_vide + 1
        End If
    Next
End Function

Je vous rappelle que je ne suis pas sur que ma façon de voir les choses est la plus optimale, c'est pourquoi je suis là !!!!

[mercatog]

déjà une première remarque, évite les select, par exemple au lieu

Code :

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

1
2
3
     Range("E" & i).Cut
Range("G" & i).Select
ActiveSheet.Paste

Code :

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

1
2
3
  Range("E" & i).Cut Range("G" & i)
Else
  Range("E" & i).ClearContents

regarde du côté de InStrRev

Code :

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

iPos1 = InStrRev(sChaine, "-")

sans boucle

Code :

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

1
2
3
            sChaine = Range("B" & i).Value
            ipos1 = InStrRev(sChaine, "-")
            Range("B" & i).Value = Mid(sChaine, ipos1 + 1)

[Yolak]

Merci pour cette première réponse,
effectivement c'est plus logique. JE ne savais même pas qu'on pouvais mettre des arguments à .Cut

Petite précision:
J'ai mis:

Code :

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

Application.ScreenUpdating = false

Dans un autre bout de code :p

[Yolak]

déjà une première remarque, évite les select, par exemple au lieu [code]
regarde du côté de InStrRev

Code :

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

iPos1 = InStrRev(sChaine, "-")

sans boucle

Ok ca c'est fait, merci !

[mercatog]

au cas de suppression de lignes
commencer la boucle de la fin et remonter

Code :

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

For i= iNb_Lignes  to 1 Step -1

sinon, toutes les lignes ne seront pas traitées

et revoir le i=i-1!

[mercatog]

oui tu peux utiliser directement dans ton code

Code :

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

Application.WorksheetFunction.CountBlank(rCible)

[Yolak]

Merci a mercatog pour ses précieux conseils!!!!!!

J'ai fait des tests, j'ai gagné presque 1/3 de temps d'exécution !
Voilà à quoi ressemble mon code maintenant:

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
Public Sub Suppression_doublons()
 
    'Les déclarations des variables
    Dim sNumTel As String, sNom As String, sAdd As String, iCP As String
    Dim iNb_Lignes As Integer, iPos1 As Integer, iNombreCell_1 As Integer, iNombreCell_2 As Integer
    Dim rCible As Range, iLigne As Integer, rRgeA As Range, rRgeB As Range
 
    'initialisation des variables
    iPos1 = 0
 
    iNb_Lignes = ActiveSheet.UsedRange.Rows.Count
 
    'Boucle sur toutes les lignes du fichier
    For i = iNb_Lignes To 1 Step -1
 
 
        'On en profite pour faire le transfert des numéros de mobile de la colonne "fixe" vers la colonne "mobile"
        '#####################################
        If Left(Range("E" & i).Value, 2) = "06" Then
            If Range("G" & i).Value = "" Then
            Range("E" & i).Cut Range("G" & i)
            Else
            Range("E" & i).ClearContents
            End If
        End If
 
        'On en profite pour faire la Suppression des parasites symbolisés par "-" dans la colonne B
        '#####################################
        'Dans la colonne B, on ne veut garder que les données se trouvant APRES le dernier tiret
        sChaine = Range("B" & i).Value
        iPos1 = InStrRev(sChaine, "-")
        If iPos1 <> 0 Then
            Range("B" & i).Value = Mid(sChaine, iPos1 + 1)
        End If
 
 
        'Suppression des doublons
        '#####################################
 
        sNumTel = Range("E" & i).Value
        sNom = Range("A" & i).Value
        iCP = Range("C" & i).Value
        sAdd = Range("B" & i).Value
 
        If sNumTel <> "" Then
            Set rCible = Range("E1:E" & i).Find(what:=sNumTel, lookat:=xlWhole)
            If Not rCible Is Nothing Then
            iLigne = rCible.Row
            'On supprime un doublons uniquement si les colonnes A,B et C sont identiques
                If Range("A" & iLigne) = sNom And ange("B" & iLigne) = sAdd And Range("C" & iLigne) = iCP Then
                    Set rRgeA = Range("A" & i & ":K" & i)
                    Set rRgeB = Range("A" & iLigne & ":K" & iLigne)
                    iNombreCell_1 = Application.WorksheetFunction.CountBlank(rRgeA)
                    iNombreCell_2 = Application.WorksheetFunction.CountBlank(rRgeB)
 
                    'La ligne contenant le plus de colonne vide est supprimée
                    If iNombreCell_1 > iNombreCell_2 Then
                        Range("A" & iLigne).EntireRow.Delete
                    ElseIf i <> iLigne Then
                        Range("A" & i).EntireRow.Delete
                    End If
                End If
            End If
        End If
    Next i
End Sub

Si vous avez des suggestions, n'hésitez pas, je suis preneur!