Optimiser une macro

Version imprimable

Optimiser une macro

Bonjour à tous,

j'ai écris cette macro, qui fonctionne seulement elle est pas optimale vu qu'elle consomme un temps fou pour obtenir le résultat.

en fait j'ai deux feuilles "feuil1" et "feuil2" ---> ce que je cherche à faire c'est de chercher l'équivalent de chaque cellule de la colonne C de la feuille 1 dans la colonne B de la feuille 2 ---> une fois trouvé il doit m'afficher le contenu de la cellule de la colonne C de la feuille 2 dans la colonne CV de la feuille 1.

en fait une recherchev fait l'affaire seulement je veux pas faire du Recherchev.

ex:

feuille1......................feuille 2
colonne B...................colonne B...............colonne C
A...............................A.........................Toto
B...............................G.........................Tata
C...............................C .........................Titi
D...............................D..........................Bla
.................................B..........................Mami

mon résultat est:

feuille1
colonne B........................................colonne CV
A...................................................Toto
B....................................................Mami
C....................................................Titi
D....................................................Bla
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 Sub Externe() For j = 0 To Cells(65536, 3).End(xlUp).Row - Cells(1, 3).Row k = 0 Do While Not (Worksheets("Feuil2").Cells(k + 2, 2) = Worksheets("Feuil1").Cells(j + 2, 3) _ Or IsEmpty(Worksheets("Feuil2").Cells(k + 2, 2))) k = k + 1 Loop Worksheets("Feuil1").Cells(j + 2, 100) = Worksheets("Feuil2").Cells(k + 2, 3) Next End Sub
je crois que le fait de boucler avec une boucle do...loop n'est pas optimal.
peut être qu'il faut passer par des variables tableau???

Merci

02/05/2008, 20h52
deuxmains

heu juste pour info ta macro dois gérer combien de lignes?

si effectivement tu dois la faire tourner sur 65536 lignes par feuille c'est normal que ça prenne du temps :)
02/05/2008, 20h57
PiliSql

elle tourne pas sur 65536 lignes.

Bonsoir
voici un code avec 1500 lignes il fait 0,4 s

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Sub test()
Dim rngBF1 As Range, rngBF2, cell As Range
Dim temp, i As Integer
i = 1
 
Set rngBF1 = Sheets("Feuil1").Range("B2:" & Sheets( _
             "Feuil1").Cells(Rows.Count, 2).End(xlUp).Address)
Set rngBF2 = Sheets("Feuil2").Range("B2:" & Sheets( _
             "Feuil2").Cells(Rows.Count, 2).End(xlUp).Address)
 
ReDim temp(1 To rngBF1.Count)
 
For Each cell In rngBF2
If Not IsError(Application.Match(cell, rngBF1, 0)) Then
   temp(i) = cell.Offset(, 1).Value
   i = i + 1
   End If
Next
 
Sheets("Feuil1").Range("CV2").Resize(i, 1).Value = Application.Transpose(temp)
 
End Sub

Bonne soirée.

EDIT
tu peux remplacer cette ligne de code pour ignorer les champs vides de la colonne C

Code:

temp(i) = cell.Offset(, 1).Value

par

Code:

If Not IsEmpty(cell.Offset(, 1).Value) Then temp(i) = cell.Offset(, 1).Value:i = i + 1

03/05/2008, 19h30
PiliSql

Bonjour Abed_H
Ton code ne prend pas en compte le cas où j'ai des doublons dans ma colonne B de la feuille 1

du moment où j'ai des doublons dans ma colonne B ---> le code ne fonctionne plus.

je ne sais pas pourquoi ???

Quelqu'un pourra - t - il m'aider à convertir mon code exposé ci-dessus, en code plus optimal ------> passer par des variables tableau

Salut à tous
Attention :
- La macro est dans un module général (pas un module de classe feuille) ou dans le module ThisWorkBook
- Le nom des feuilles est à vérifier/adapter
Pour toutes les cellules (Cel) de Feuil1 colonne B
vider cel_1
rechercher la cellule égale en feuil2 colonne B et stocker la cellule en variable Cel_1
Si Cel_1 n'est pas vide mettre la valeur de la colonne de droite de cel_1 dans la colonne de droite de la cellule testée :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 Sub Externe() Dim Cel As Range Dim F_1 As Worksheet Dim F_2 As Worksheet Dim Cel_1 As Range Set F_1 = Sheets("Feuil1") Set F_2 = Sheets("Feuil2") For Each Cel In Range(F_1.[B1], F_1.[B65536].End(xlUp)) Set Cel_1 = Nothing Set Cel_1 = F_2.Range(F_2.[B1], F_2.[B65536].End(xlUp)).Find(Cel, LookIn:=xlValues) If Not (Cel_1 Is Nothing) Then Cel.Offset(0, 1) = Cel_1.Offset(0, 1) Next Cel End Sub
A+

04/05/2008, 22h00
PiliSql

Gorfael ---> toujours à ma rescousse.

ça marche nikel

Merci à toi aussi Abed_H
04/05/2008, 22h43
PiliSql

Je me permets de relancer la discussion.

En fait si Cel_1 est nothing, je voudrais stocker dans un tableau toutes les Cel que je ne trouve pas dans la feuille2
et à la fin de la macro je les affiche dans une feuille 3.
Merci

Salut PiliSql
Me semblerai plus simple de les copier au fur et à mesure

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub Externe()
Dim Cel As Range
Dim F_1 As Worksheet
Dim F_2 As Worksheet
Dim Cel_1 As Range
Set F_1 = Sheets("Feuil1")
Set F_2 = Sheets("Feuil2")
For Each Cel In Range(F_1.[B1], F_1.[B65536].End(xlUp))
    Set Cel_1 = Nothing
    Set Cel_1 = F_2.Range(F_2.[B1], F_2.[B65536].End(xlUp)).Find(Cel, LookIn:=xlValues)
    If Cel_1 Is Nothing Then
        Cel.Copy F_2.Range("B" & F_2.[B65536].End(xlUp).Row + 1)
    Else
        Cel.Offset(0, 1) = Cel_1.Offset(0, 1)
    End If
Next Cel
End Sub

un truc dans ce style, qui permet d'éviter d'avoir à traiter les doublons
A+

20/05/2008, 20h18
PiliSql

Non Gorfael,

Moi j'aimerais les stocker dans un tableau pour ensuite imprimer une sorte de rapport d'erreur soit à l'aide de word soit bloc notes.