Discussion :

[chloe74]

Bonsoir,
j'ai essayer de crée une macro mais elle ne fonctionne pas mais je ne vois pas d'ou vient le problème si quelqu'un pourrait m'aider svp ?

De colonne A à D il y a de suites de chiffres ( la colonne H la range ), au maximum jusqu’à la ligne 200.000 environ, et de colonne K à N ( colonne P la range ) il y a les consignes allant jusqu’à la ligne 40 000, et de colonnes R à U se sont les résultats qui seront copier :

donc la macro va vérifier si les valeur de la colonne P apparais dans celle de la colonnes H et s'il n’apprissent pas alors copier les colonnes des lignes qui n'apparaissent pas.
voici le fichier excel et la macro : forum_excel.xlsm
merci de votre aide

[Invité]

Bonjour,

Dans ce code, la dernière ligne est prise par rapport à la colonne P et la comparaison se fait ligne par ligne (c'est là que je n'ai peut-être pas tout compris).
Les colonnes 18 à 21 contiennent les valeurs des colonnes A à D non trouvées lorsq'un écart est constaté.

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
 
Sub RechercheConsignes()
 
Dim X As Long, Y As Long, DerLigBase As Long, NbNonTrouves As Long
Dim Trouve As Boolean
Dim Debut As Variant, Fin As Variant, Delai As Variant
 
        Application.ScreenUpdating = False
        Application.Calculation = xlCalculationManual
 
        Debut = Now
 
        With Sheets("Feuil1")
 
             ' La dernière ligne est prise sur la colonne P
             DerLigBase = .Cells(.Rows.Count, 16).End(xlUp).Row
             .Range(.Cells(2, 18), .Cells(.Rows.Count, 21)).ClearContents
 
             For X = 2 To DerLigBase
                 Trouve = False
                 If .Cells(X, 8).Value = .Cells(X, 16).Value Then Trouve = True
 
                 If Trouve = False Then
                    For Y = 18 To 21
                        If .Cells(X, Y - 17).Value <> .Cells(X, Y - 7).Value Then .Cells(X, Y) = .Cells(X, Y - 17).Value
                    Next Y
                    NbNonTrouves = NbNonTrouves + 1
                End If
                Trouve = False
             Next X
 
        End With
 
        Application.ScreenUpdating = True
        Application.Calculation = xlCalculationAutomatic
 
        Fin = Now
 
        Delai = Fin - Debut
 
        MsgBox "Fin de traitement, lignes non trouvées : " & NbNonTrouves & vbNewLine & vbNewLine & "Début:" & vbTab & Debut & vbNewLine & "Fin:" & vbTab & Fin & vbNewLine & "Délai:" & vbTab & Round(Delai, 0), vbInformation, "Traitement terminé"
 
End Sub

[chloe74]

bonjour, désolé du retard,
il y a un problème car elle recopie même la ligne contenant 2/3/4/5 alors qu'il apparait dans la ligne 16
voici le classeur :forum_excel.xlsm
merci

[chloe74]

j'ai réussi à trouver la macro mais elle est trop longue à s'exécuter :
pour 35 000 lignes à traiter et 90 000 consignes cela à mis plus de 6 heures j'ai dû stopper
pour 210 000 lignes à traiter avec 500 consignes cela met 6 min
voici la macro ( je ne peux joindre le fichier car il dépasse 2 Mo ) :

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
Dim X As Long
Dim Y As Long
Dim DerLigBase As Long
Dim DerLigCode As Long
Dim DerligPasTrouve As Long
Dim Trouve As Boolean
 
debut = Now
Trouve = False
DerligPasTrouve = 2
DerLigBase = Feuil1.Cells(Rows.Count, 1).End(xlUp).Row
DerLigCode = Feuil1.Cells(Rows.Count, 12).End(xlUp).Row
With Feuil1
    .Range("S2:W200000").Select
    Selection.ClearContents
    .Range("S2").Select
    For X = 2 To DerLigBase
        For Y = 2 To DerLigCode
            If .Cells(X, 8).Value = .Cells(Y, 17).Value Then
            ' trouvé
            Trouve = True
            Y = DerLigBase
            End If
        Next Y
        If Trouve = False Then
            For Y = 1 To 4
            .Cells(DerligPasTrouve, Y + 18).Value = .Cells(X, Y).Value
            Next Y
        DerligPasTrouve = DerligPasTrouve + 1
        End If
        Trouve = False
    Next X
End With

[Menhir]

Déjà, il y a à priori une incohérence dans ton code entre ces trois ligne :

Code :

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

1
2
3
For X = 2 To DerLigBase
For Y = 2 To DerLigCode
Y = DerLigBase

Si le but de la dernière ligne est de sortir de la seconde boucle For, Y devrait être assigné à DerLigCode et non DerLigBase.

Ton code retouché :

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
Dim X As Long
Dim DerLigBase As Long
Dim DerligPasTrouve As Long
Dim Trouve As Range
 
debut = Now
DerligPasTrouve = 2
DerLigBase = Feuil1.Cells(Rows.Count, 1).End(xlUp).Row
 
Worksheets("Feuil1").Select
Range("S2", Cells(Row.Count, "W").End(xlUp)).ClearContents
For X = 2 To DerLigBase
    Columns(17).Find (Cells(X, 8).Value)
    If Trouve Is Nothing Then
        Range("A1:D1").Offset(X - 1, 0).Copy Cells(DerligPasTrouve, 19)
        DerligPasTrouve = DerligPasTrouve + 1
    End If
Next X

Attention, j'ai tapé ça à l'arrache directement sur le forum pour te montrer le principe.
Je n'ai pas testé. Tu auras donc peut-être du débugage à faire.

[chloe74]

j'ai testé votre macro, il n'y a pas eu de débogage mais par contre elle est longue en exécution que la mienne :/

[Invité]

Bonjour,

Il vous faut tester en plus :

Code :

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

1
2
 
 .Cells(X, 16).Value <> "   "

[laurent_ott]

Bonjour.
Je pense que le traitement irait plus vite si les données étaient triées et qu'une recherche dichotomique était appliquée.
Voir la solution dans le tome 6 dans ma signature (lisible sur PC mais pas sur téléphone).