Discussion :

[auriga69]

Bonjour,

On vient de me demander de dépanner une macro qui ne fonctionne pas .....
Elle a pour but de comparer les valeurs (chiffres et lettres) des cellules de 2 colonnes (A) dans 2 feuilles différentes ( feuil2 et Feuil3) dans 2 classeurs (Encours-CTI et Classeurs2).
Des qu'une valeur est identique, nous voulons une copie des cellules B à T de la ligne concernée dans Feuil2 vers H de la ligne concernée de la Feuil3.

Quand je lance cette macro (située dans le classeur Encours-CTI), rien ne se passe, Execl est figé .. bref j'ai l'impression que cela tourne en boucle. je suis obligé d’arrêter l’exécution au bout de plusieurs minutes.

Quelqu'un peut me donner un coup de main ? Merci

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
Sub comparaison()
'
' comparaison Macro
'
'
Dim VALEURA As String, VALEURB As String
'
For i = 2 To 5000
VALEURA = Worksheets("Feuil2").Range("A" & i).Value
For j = 2 To 5000
VALEURB = Workbooks("Encours-CTI.xls").Worksheets("Feuil3").Range("A" & j).Value
If VALEURA = VALEURB Then
Workbooks("Encours-CTI.xls").Worksheets("Feuil3").Range(Range("B" & j), Range("T" & j)).Copy
Workbooks("Classeur2.xlsm").Worksheets("Feuil2").Range("H" & i).Paste
End If
Next j
Next i
End Sub

[Gado2600]

Bonjour,

C'est un peu normal que cela soit long car, de ce que je lis, tu fais une double boucle sur 4999 lignes, soit 24 990 001 comparaisons...

Deux choses en particulier qui pourraient accélérer le processus :
- serait de passer tes données dans des tableaux "virtuels" (cf. Dim tabA() as variant)
- plutôt que de dire "de 2 jusqu'à 5000", dis plutôt "de 2 à ma dernière ligne renseignée" (cf. Worksheets("Feuil2").Range("A5001").end(xlUp).row)

Le premier point accélère énormément les comparaisons de données et le second point t'économisera éventuellement, quelques millions de comparaisons. Selon la quantité de tes données, on pourrait estimer diviser par 2 le nombre de lignes par boucles (soit 2500*2500 => 6 250 000 comparaisons).

Cordialement,

[Thautheme]

Bonjour le fil, bonjour le forum,

Le code ci-dessous quand une occurrence est identique ne continue pas la seconde boucle. Je ne sais pas si c'est ce que tu veux mais cela va accélérer son exécution.

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
Sub comparaison()
Dim C1 As Workbook
Dim C2 As Workbook
Dim O1 As Worksheet
Dim O2 As Worksheet
Dim VALEURA As String
Dim VALEURB As String
 
Set C1 = ThisWorkbook
Set O1 = C1.Sheets("Feuil2")
Set C2 = Workbooks("Encours-CTI.xls")
Set O2 = C2.Sheets("Feuil3")
For I = 2 To 5000
    VALEURA = CStr(O1.Cells(I, 1).Value)
    For J = 2 To 5000
        VALEURB = CStr(O2.Cells(J, 1).Value)
        If VALEURA = VALEURB Then O2.Cells(J, 2).resise(1, 19).Copy O1.Cells(I, 8)
        Exit For
    Next J
Next I
End Sub

Mais je suis tout à fait d'accord avec Gado et te propose une version avec des variables tableaux :

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
Sub comparaison2()
Dim C1 As Workbook
Dim C2 As Workbook
Dim O1 As Worksheet
Dim O2 As Worksheet
Dim TC1 As Variant
Dim TC2 As Variant
Dim TL() As Variant
 
Set C1 = ThisWorkbook
Set O1 = C1.Sheets("Feuil2")
Set C2 = Workbooks("Encours-CTI.xls")
Set O2 = C2.Sheets("Feuil3")
TC1 = O1.Range("A1").CurrentRegion
TC2 = O2.Range("A1").CurrentRegion
For I = 2 To UBound(TC1, 1)
    K = 1
    For J = 2 To UBound(TC2, 1)
        If CStr(TC1(I, 1)) = CStr(TC2(J, 1)) Then
            ReDim Preserve TL(1 To 19, 1 To K)
            For L = 1 To 19
                TC(L, K) = TC2(L + 1, J)
            Next I
            K = K + 1
            If K > 1 Then O1.Cells(I, 8).resise(1, 19).Value = Application.Transpose(TL)
            Exit For
        End If
    Next J
Next I
End Sub

[auriga69]

Bonjour à tous,

Merci à Gado et Thautheme pour vos réponses.

Je viens de copier le code (le dernier avec les variables tableaux) puis de le lancer .. j'ai une erreur sur la ligne 22 avec le code 9 l'indice n'appartient pas à la sélection.

Merci de me donner un petit coup de main

Auriga

[Gado2600]

Bonjour,

C'est fort possible d'après ce que je vois (sauf si je suis mal réveillé...) :
TC(L, K) n'est pas une variable déclarée et je ne vois nulle part d'attribution de données dedans ni de dimensionnement.

Mais c'est une hypothèse par rapport au post précédent. Comme on n'a pas le code que tu as "adapté", on ne peut pas t'aider dessus. Le mode pas-à-pas (F8 et le point d'arrêt F9) existe et pourrait te permettre d'identifier la partie qui pose problème et de remonter à sa source.

Cordialement,

[auriga69]

Bonjour,

J'ai remplacé TC(L, K) par TL(L,K) .. voici le code que j'ai utilisé

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
 
 
 Sub comparaison()
Dim C1 As Workbook
Dim C2 As Workbook
Dim O1 As Worksheet
Dim O2 As Worksheet
Dim TC1 As Variant
Dim TC2 As Variant
Dim TL() As Variant
 
Set C1 = ThisWorkbook
Set O1 = C1.Sheets("Feuil2")
Set C2 = Workbooks("Encours-CTI.xls")
Set O2 = C2.Sheets("Feuil3")
TC1 = O1.Range("A1").CurrentRegion
TC2 = O2.Range("A1").CurrentRegion
For i = 2 To UBound(TC1, 1)
    k = 1
    For j = 2 To UBound(TC2, 1)
        If CStr(TC1(i, 1)) = CStr(TC2(j, 1)) Then
            ReDim Preserve TL(1 To 19, 1 To k)
            For L = 1 To 19
                TL(L, k) = TC2(L + 1, j)
            Next
            k = k + 1
            If k > 1 Then O1.Cells(i, 8).resise(1, 19).Value = Application.Transpose(TL)
            Exit For
        End If
    Next j
Next i
End Sub

A priori l'erreur se situe sur la ligne 22 mais pour TC2(L + 1, j)

Merci pour l'aide