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 : 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 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
Partager