Discussion :

[monteverest]

Bonjour à tous,

J'ai la macro ci-dessous qui me prend beaucoup trop de temps d'exécution.
Elle n'a (pour le moment) que 100 lignes à traiter.

Voudriez-vous m'indiquer s'il existe quelque chose de (beaucoup) plus efficace s'il vous plait ?

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
44
45
46
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
 
Call Macro97
Dim i As Long
Dim a As Long
Dim b As Long
Dim c As Long
Dim d As Long
Dim e As Long
derligW = Range("W65000").End(xlUp).Row
derligBU = Range("BU65000").End(xlUp).Row
For i = 1 To derligW
    For a = 1 To derligBU
        For b = a To derligBU
            For c = b To derligBU
                For d = c To derligBU
                    For e = d To derligBU
 
                        If (Cells(i, 1) = Cells(a, 73) And Cells(i, 2) = Cells(b, 73) And Cells(i, 3) = Cells(c, 73))  _
                           Or (Cells(i, 1) = Cells(a, 73) And Cells(i, 2) = Cells(b, 73) And Cells(i, 4) = Cells(d, 73))  _
                           Or (Cells(i, 1) = Cells(a, 73) And Cells(i, 2) = Cells(b, 73) And Cells(i, 5) = Cells(e, 73))  _
                           Or (Cells(i, 1) = Cells(a, 73) And Cells(i, 3) = Cells(c, 73) And Cells(i, 4) = Cells(d, 73))  _
                           Or (Cells(i, 1) = Cells(a, 73) And Cells(i, 3) = Cells(c, 73) And Cells(i, 5) = Cells(e, 73))  _
                           Or (Cells(i, 1) = Cells(a, 73) And Cells(i, 4) = Cells(d, 73) And Cells(i, 5) = Cells(e, 73)) _
                           Or (Cells(i, 2) = Cells(b, 73) And Cells(i, 3) = Cells(c, 73) And Cells(i, 4) = Cells(d, 73)) _
                           Or (Cells(i, 2) = Cells(b, 73) And Cells(i, 3) = Cells(c, 73) And Cells(i, 5) = Cells(e, 73)) _
                           Or (Cells(i, 2) = Cells(b, 73) And Cells(i, 4) = Cells(d, 73) And Cells(i, 5) = Cells(e, 73)) _
                           Or (Cells(i, 3) = Cells(c, 73) And Cells(i, 4) = Cells(d, 73) And Cells(i, 5) = Cells(e, 73)) Then
                              Range(Cells(i, 23), Cells(i, 27)).Copy
                              Range("BX65000").End(xlUp).Select
                              ActiveCell.Offset(1, 0).Select
                              ActiveSheet.Paste
                              GoTo un
                        End If
 
                    Next e
                Next d
            Next c
        Next b
    Next a
un:
Next i
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

En vous remerciant par avance...

[Franc]

Salut, perso je trouve que un peu d'explication en français pour expliquer ce que ta macro est censée faire ce serait cool

[monteverest]

Bonjour,

Oui effectivement.

Macro97 efface les résultats précédents sur les colonnes BX a CB

Je recherche toutes les lignes dans un tableau (W : AA) pour lesquelles j'ai trois numéros présents dans la colonne BU.
Si ligne trouvée alors copie de cette ligne en colonne BX (les une sous les autres.
Voilà

En espérant avoir été clair

Cordialement

[deedolith]

Oulah, un peut normal que ce soit lent, avec 6 boucles For imbriquées ...

Avec 100 lignes, ca fait deja 1 000 000 000 000 tours de boucles (1000 milliards !!!)

Quelques pistes:
1) Application.WorksheetFunction.Find sera peut être plus éfficasse que parcourir cellule par cellule.
2) Concaténer chaque ligne en une châine de caractère et effectuer des comparaisons (on a plus qu'une seul boucle).
3) Transférer les cellules dans un tableau.
Manipuler un tableau est beaucoup plus rapide que manipuler des cellules:

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
Sub test()
    Dim Tabl() As Variant
    Tabl = Sheets("Feuil1").Range("A1:Z300").Value    '// Copie des valeurs de cellules dans le tableau Tab
 
        '// Le tableau Tab est un tableau 2D
    Dim i As Integer
    For i = LBound(Tabl, 1) To UBound(Tabl, 2)
        Dim j As Integer
        For j = LBound(Tabl, 2) To UBound(Tabl, 2)
            '// Traitement de Tab(i, j)
        Next
    Next
 
    Sheets("Feuil1").Range("A1:Z300").Value = Tabl   '// Copie du tableau vers les cellules
End Sub

[Franc]

A tester, je n'ai pas Excel 365, et peut-être que je n'ai pas compris exactement ce que tu veux. J'utilise des dictionnaires pour stocker les données et ensuite faire les recherche, ça évite toutes ces boucles imbriquées et pourra éventuellement te servir de piste de recherche.

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
  Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
 
    Dim dictWtoAA As Object
    Set dictWtoAA = CreateObject("Scripting.Dictionary")
    Dim dictBU As Object
    Set dictBU = CreateObject("Scripting.Dictionary")
 
    Dim i As Long
    Dim lastRowW As Long
    lastRowW = Range("W" & Rows.Count).End(xlUp).Row
 
    ' Stockage des données des colonnes  W à AA dans un dictionnaire
    For i = 1 To lastRowW
        dictWtoAA(Cells(i, 23).Value & "|" & Cells(i, 24).Value & "|" & Cells(i, 25).Value & "|" & Cells(i, 26).Value & "|" & Cells(i, 27).Value) = i
    Next i
 
    Dim lastRowBU As Long
    lastRowBU = Range("BU" & Rows.Count).End(xlUp).Row
 
    ' Stockage des données de la colonne  BU dans un dictionnaire
    For i = 1 To lastRowBU
        dictBU(Cells(i, 73).Value) = i
    Next i
 
    Dim key As Variant
    Dim values As Variant
    Dim rowBX As Long
    rowBX = 1
 
    ' Trouve des correspondances et copie vers colonne BX
    For Each key In dictWtoAA.keys
        values = Split(key, "|")
        If dictBU.exists(values(0)) And dictBU.exists(values(1)) And dictBU.exists(values(2)) Then
            Rows(dictWtoAA(key)).Copy Destination:=Cells(rowBX, 76)
            rowBX = rowBX + 1
        End If
    Next key
 
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

[jurassic pork]

Hello,
je n'ai peut-être pas bien compris ce que tu recherches mais si c'est de recopier le contenu de la colonne BU dans la colonne BX lorsque le contenu de BU est au moins présent 3 fois dans les colonnes W à AA de la même ligne, une simple formule suffit en BX. Exemple :

=SI(NB.SI(W1:AA1;BU1)>2;BU1;"")

En colonne BY il y a le nombre de fois que la valeur de BU est présente dans les colonnes W à AA
Ami calmant, J.P

[Raccourcix]

Bonjour

une autre proposition suivant ma compréhension de la question.

Soit un tableau de 5 colonnes avec des valeurs, je cherche à filtrer les lignes qui contiennent 3 valeurs déterminées

Ici, 5000 lignes avec une combinaison aléatoire de A..Z.
Je filtre les lignes qui contiennent à la fois un A un B et un C.

une colonne de test avec un ET(ESTNUM(EQUIV pour vérifier que les 3 valeurs cherchées sont présentes
un FILTRE du tableau sur ce test.
le retour est immédiat



Stéphane