Optimisation du temps d'exécution d'un code vba
Bonjour à tous,
Je viens de commencer à apprendre le langage VBA et j'éprouve quelques difficultés..
Je dois créer un code qui utilise deux listes différentes et créé à partir de celles-ci une liste concaténée sans doublons.
Petite précision : mes listes sont très longues (6000+ cellules)
Je me suis débrouillée pour écrire une ébauche de code mais il met 40 min à s'exécuter, et le résultat qui s'affiche est faux, alors que lorsque je teste sur 200 valeurs tout va bien.
J'ai lu dans d'autres post qu'il fallait passer par un tableau mais je n'arrive pas à écrire une procédure sans erreur..
Pourriez-vous m'aider ?
Merci d'avance !
Voici mon code :
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 Fusion_sans_doublon()
Dim J As Long 'on définit l'incrément
Dim L As Long 'on définit l'incrément
Dim DLigneA As Long
Dim DLigneC As Long
Dim DLigneE As Long
DLigneA = Range("A1").End(xlDown).Row 'dernière ligne de la colonne A (liste 1)
DLigneC = Range("C1").End(xlDown).Row 'dernière ligne de la colonne C (liste 2)
DLigneE = Range("E1").End(xlDown).Row 'dernière ligne de la colonne E (liste concaténée sans doublons)
Workbooks("Mon_classeur").Worksheets("Ma_feuille").Range("E2:E18000").Select 'on efface la colonne E
Selection.ClearContents
Workbooks("Mon_classeur").Worksheets("Ma_feuille").Range("C2:C18000").Select 'on copie la colonne C dans la colonne E
Selection.Copy
Cells(2, 5).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
L = 2
For J = 2 To DLigneA 'pour chaque ligne de la colonne A, on teste si la valeur est dans la colonne C
DLigneE = Range("E1").End(xlDown).Row
While Cells(J, 1) <> Cells(L, 3) And L <= DLigneC 'tant que la valeur testée ne se trouve pas dans la colonne
L = L + 1 'on augmente l'incrément
Wend 'on est sorti de la boucle While: soit la valeur est dans la colonne C, soit on a cherché dans toute la liste C et elle n'y est pas
If L = DLigneC + 1 And Cells(J, 1) <> Cells(DLigneC, 3) Then 'si l'incrément L vaut le nombre de lignes de la colonne
Cells(DLigneE + 1, 5) = Cells(J, 1) 'on remplit la colonne E de la valeur
End If
Next J
End Sub |
