Discussion :

[FanClub51]

Bonjour,
Je recherche une solution pour s'implifié le programme que j'utilise actuelement :
avec un FOR... NEXT, le programme regarde dans un classeur, ligne par ligne, si la colonne AT contient une information precise. si oui, des donnnées de la ligne sont copiées dans un autre classeur. cela marche bien, mais avec le temps ma base atteint 82.000 lignes et cela prend enormement de temps (± 1 heure), pour seulement plusieurs centaine de ligne à copier.
J'avais pensé s'implifier, en utilisant un filtre sur la colonne AT, et remplacer le FOR...NEXT par la lecture des lignes visible, en descendant le curseur, ligne visible après ligne visible, et retourner l'adresse de cette ligne pour la copie des données.
j'ai trouvé OFFSET et SPECIALCELLS(xlCellTypeVisible), mais n'arrive pas a compiler les deux...
avez-vous une solution pour ameliorer mon programme.
Merci

[PPz78]

Bonsoir,

Tu peux faire un tri sur la colonne AT, de cette façon les lignes qui t'intéressent seront jointives.

PPz

[FanClub51]

l'idée est pas mauvaise, (j'avais pas pensé), même bonne
mais toujours la même chose 82.000 lignes a trier, puis action (prog), puis re-trier pour remetre dans l'ordre; sans oublier que j'utilise des couleurs en plus des alpha-numérique.
mais l'idée est bonne, sauf que j'aurais aimé une sol. pour d'autre prog

[mercatog]

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
Public Sub AAAA()
Dim LastLig As Long, Lig As Long
Dim c As Range
 
Application.ScreenUpdating = False                          'Inhibe la mise à jour affichage écran (diminue le temps d'exécution)
With Sheets("Feuil1")                                       'Adapte à ta feuille
    .AutoFilterMode = False                                 'Enlève le filtre auto s'il existe
    LastLig = .Cells(Rows.Count, "AT").End(xlUp).Row        'Dernière ligne de données, on peut remplacer "AT" par la colonne contenant la dernière donnée
    With .Range("AT1:AT" & LastLig)
        .AutoFilter field:=1, Criteria1:="X"                'On filtrer sur la colonne AT, remplace "X" du criteria1 par ton critère
        For Each c In .SpecialCells(xlCellTypeVisible)      'Pour chaque cellule visible de la colonne AT
            Lig = c.Row                                     'Lig récupère les lignes visibles
            If Lig > 1 Then                                 'Pour ne pas traiter la première ligne des titres
                'suite des traitements avec dans Lig la valeur de la ligne filtrée visible
                '...........
            End If
        Next c
    End With
    .AutoFilterMode = False                                 'Enlève le filtre auto
End With
End Sub

Une question subsidiaire, peut être tu auras à mettre ton code en entier pour voir la question de la lenteur d'exécution du code

[FanClub51]

merci mercatog,
ça marche bien en le lançant du VB (F5), mais pas de ma feuille excel !
dans ce dernier cas, il a l'air de fonctionner normalement, mais il ne copie pas mes données...

peut-on faire le «.AutoFilter field:=1, Criteria1:="X"» avec deux critères : =10 mais le fond pas de couleur verte ? (imposible sous excel)
merci

[mercatog]

peut-on faire le «.AutoFilter field:=1, Criteria1:="X"» avec deux critères : =10 mais le fond pas de couleur verte ?

Incompréhensible.
Je réitère ma question subsidiaire: tu peux mettre ton code en entier pour pouvoir se prononcer?
Sans effort d'expliquer proprement et clairement, tu auras à attendre longtemps et surtout surcharger inutilement ce précieux forum.

[FanClub51]

désolé, j'ai voulu aller trop vite.
peut-on metre deux critères :
1) egal 10
&
2) le fond (interior) de la cellule ne doit pas etre de la couleur «verte»

je comprend que tu desir 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
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
Sub uson()
Dim xdfin As Long, xd As Long
Dim c As Range
Dim xdnam, xdusn, xdlau, xddel, xdtri, xdcha, xdhul, xdhco
Dim xdcg, xdmi, xdgl, xdon, xdcgp
Dim xda, xdb, xdc, xdd, xde, xdf, xdl, xdv
Dim xd0vi, xd0bl, xd1bl, xd0or, xd0rg, xd0vt, xd1vt, xd0ft, xd6bl
xda = "use"
xdb = "ON"
'xdfin = Sheets(xda).UsedRange.Rows(Sheets(xda).UsedRange.Rows.Count).Row
xd0vi = 10642560 'violet uscg
xd0bl = 12419407 'bleu miramar
xd1bl = 13020235 'bleu clair miramar
xd0or = 4626167 'orange miramar
xd0rg = 255 'rouge miramar OU rouge ERREUR
xd0vt = 32896 'vert great lakes
xd1vt = 307372 'vert pale great lakes
xd0ft = 3394611 'vert FAIT
xd6bl = 15773696 'bleu 1887
 
'Application.ScreenUpdating = False                          'Inhibe la mise à jour affichage écran (diminue le temps d'exécution)
With Sheets(xda)                                       'Adapte à ta feuille
    .AutoFilterMode = False                                 'Enlève le filtre auto s'il existe
    xdfin = .Cells(Rows.Count, "AT").End(xlUp).Row        'Dernière ligne de données, on peut remplacer "AT" par la colonne contenant la dernière donnée
    With .Range("AT1:AT" & xdfin)
        .AutoFilter field:=1, Criteria1:=10                'On filtrer sur la colonne AT, remplace "X" du criteria1 par ton critère
        For Each c In .SpecialCells(xlCellTypeVisible)      'Pour chaque cellule visible de la colonne AT
            xd = c.Row                                     'Lig récupère les lignes visibles
            If xd > 1 Then                                 'Pour ne pas traiter la première ligne des titres
 
'For xd = 2 To xdfin
Sheets(xda).Cells(xd, 46).Select
'xdc = Sheets(xda).Cells(xd, 46) 'AT verif
'If Not xdc = 10 Then GoTo xdsuit
xdd = Sheets(xda).Cells(xd, 46).Interior.color
If xdd = xd0ft Then GoTo xdsuit
xdon = Sheets(xda).Cells(xd, 43)    'AQ us nbr
xdtri = Sheets(xda).Cells(xd, 1)    'A tri
xdcha = Sheets(xda).Cells(xd, 2)    'B builder
xdhul = Sheets(xda).Cells(xd, 5)    'E hull#
xdhco = Sheets(xda).Cells(xd, 5).Interior.color
xdnam = Sheets(xda).Cells(xd, 7)    'G orig name
xdusn = Sheets(xda).Cells(xd, 14)   'N usn hull
xdlau = Sheets(xda).Cells(xd, 28)   'AB launch
'xdlau = Right(xdlau, 5)
xddel = Sheets(xda).Cells(xd, 29)   'AC deliv
'xddel = Right(xddel, 5)
xdcg = Sheets(xda).Cells(xd, 43).Interior.color 'AQ us on
xdmi = Sheets(xda).Cells(xd, 45).Interior.color 'AS miramar
xdgl = Sheets(xda).Cells(xd, 42).Interior.color 'AP ON
xdcgp = Sheets(xda).Cells(xd, 44).Interior.color    'AR imo
xdv = xd0ft
 
Set xdf = Sheets(xdb).Columns(2).Find(xdon, lookat:=xlWhole)
If xdf Is Nothing Then xdv = xd0rg: GoTo xdapr
xdl = xdf.Row
If Sheets(xdb).Cells(xdl, 3) = "VU" Then xdv = xd0rg: GoTo xdapr
Sheets(xdb).Cells(xdl, 3) = "VU"
Sheets(xdb).Cells(xdl, 4) = xdnam
Sheets(xdb).Cells(xdl, 5) = xdusn
Sheets(xdb).Cells(xdl, 6) = xdlau
Sheets(xdb).Cells(xdl, 7) = xddel
Sheets(xdb).Cells(xdl, 8) = xdtri
Sheets(xdb).Cells(xdl, 9) = xdcha
Sheets(xdb).Cells(xdl, 10) = xdhul
Sheets(xdb).Cells(xdl, 10).Interior.color = xdhco
If xdcgp = xd0vi Then Sheets(xdb).Cells(xdl, 11) = "Vu": xdv = xd0ft
If xdcg = xd0vi Then Sheets(xdb).Cells(xdl, 11) = "OK": xdv = xd0ft
If xdmi = xd0bl Then Sheets(xdb).Cells(xdl, 12) = "OK": xdv = xd0ft
If xdmi = xd1bl Then Sheets(xdb).Cells(xdl, 12) = "OK": xdv = xd0ft
If xdmi = xd0or Then Sheets(xdb).Cells(xdl, 12) = "Faire": xdv = xd0ft
If xdmi = xd0rg Then Sheets(xdb).Cells(xdl, 12) = "Vu": xdv = xd0ft
If xdgl = xd0vt Then Sheets(xdb).Cells(xdl, 13) = "OK": xdv = xd0ft
If xdgl = xd1vt Then Sheets(xdb).Cells(xdl, 13) = "OK": xdv = xd0ft
If xdgl = xd6bl Then Sheets(xdb).Cells(xdl, 15) = "vu": xdv = xd0ft
xdapr:
Sheets(xda).Cells(xd, 46).Interior.color = xdv
 
xdsuit:
'Next xd
            End If
        Next c
    End With
    .AutoFilterMode = False                                 'Enlève le filtre auto
End With
Worksheets(xda).Range("A1").AutoFilter
End Sub

[mercatog]

évite les Select
déclarer tes variables proprement (tous en variant à réfléchir)
peut être ce 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
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
Sub uson()
Dim xdFin As Long, xd As Long
Dim c As Range
Dim xdnam, xdusn, xdlau, xddel, xdtri, xdcha, xdhul, xdhco
Dim xdcg, xdmi, xdgl, xdon, xdcgp
Dim xdf, xdl, xdv
Const xda = "use"
Const xdb = "ON"
Const xd0vi = 10642560    'violet uscg
Const xd0bl = 12419407    'bleu miramar
Const xd1bl = 13020235    'bleu clair miramar
Const xd0or = 4626167    'orange miramar
Const xd0rg = 255    'rouge miramar OU rouge ERREUR
Const xd0vt = 32896    'vert great lakes
Const xd1vt = 307372    'vert pale great lakes
Const xd0ft = 3394611    'vert FAIT
Const xd6bl = 15773696    'bleu 1887
 
Application.ScreenUpdating = False                          'Inhibe la mise à jour affichage écran (diminue le temps d'exécution)
With Sheets(xda)                                       'Adapte à ta feuille
    .AutoFilterMode = False                                 'Enlève le filtre auto s'il existe
    xdFin = .Cells(Rows.Count, "AT").End(xlUp).Row        'Dernière ligne de données, on peut remplacer "AT" par la colonne contenant la dernière donnée
    With .Range("AT1:AT" & xdFin)
        .AutoFilter field:=1, Criteria1:=10                'On filtrer sur la colonne AT, remplace "X" du criteria1 par ton critère
        For Each c In .SpecialCells(xlCellTypeVisible)      'Pour chaque cellule visible de la colonne AT
            xd = c.Row                                     'Lig récupère les lignes visibles
            If xd > 1 And Sheets(xda).Cells(xd, 46).Interior.Color <> xd0ft Then                              'Pour ne pas traiter la première ligne des titres
                xdon = Sheets(xda).Cells(xd, 43)    'AQ us nbr
                xdtri = Sheets(xda).Cells(xd, 1)    'A tri
                xdcha = Sheets(xda).Cells(xd, 2)    'B builder
                xdhul = Sheets(xda).Cells(xd, 5)    'E hull#
                xdhco = Sheets(xda).Cells(xd, 5).Interior.Color
                xdnam = Sheets(xda).Cells(xd, 7)    'G orig name
                xdusn = Sheets(xda).Cells(xd, 14)    'N usn hull
                xdlau = Sheets(xda).Cells(xd, 28)    'AB launch
                xddel = Sheets(xda).Cells(xd, 29)    'AC deliv
                xdcg = Sheets(xda).Cells(xd, 43).Interior.Color    'AQ us on
                xdmi = Sheets(xda).Cells(xd, 45).Interior.Color    'AS miramar
                xdgl = Sheets(xda).Cells(xd, 42).Interior.Color    'AP ON
                xdcgp = Sheets(xda).Cells(xd, 44).Interior.Color    'AR imo
                xdv = xd0ft
                Set xdf = Sheets(xdb).Columns(2).Find(xdon, lookat:=xlWhole)
                If Not xdf Is Nothing Then
                    xdl = xdf.Row
                Else
                    Sheets(xda).Cells(xd, 46).Interior.Color = xd0rg
                End If
 
                If Sheets(xdb).Cells(xdl, 3) = "VU" Then
                    Sheets(xda).Cells(xd, 46).Interior.Color = xd0rg
                Else
                    Sheets(xdb).Cells(xdl, 3) = "VU"
                    Sheets(xdb).Cells(xdl, 4) = xdnam
                    Sheets(xdb).Cells(xdl, 5) = xdusn
                    Sheets(xdb).Cells(xdl, 6) = xdlau
                    Sheets(xdb).Cells(xdl, 7) = xddel
                    Sheets(xdb).Cells(xdl, 8) = xdtri
                    Sheets(xdb).Cells(xdl, 9) = xdcha
                    Sheets(xdb).Cells(xdl, 10) = xdhul
                    Sheets(xdb).Cells(xdl, 10).Interior.Color = xdhco
                    If xdcgp = xd0vi Then Sheets(xdb).Cells(xdl, 11) = "Vu": xdv = xd0ft
                    If xdcg = xd0vi Then Sheets(xdb).Cells(xdl, 11) = "OK": xdv = xd0ft
                    If xdmi = xd0bl Then Sheets(xdb).Cells(xdl, 12) = "OK": xdv = xd0ft
                    If xdmi = xd1bl Then Sheets(xdb).Cells(xdl, 12) = "OK": xdv = xd0ft
                    If xdmi = xd0or Then Sheets(xdb).Cells(xdl, 12) = "Faire": xdv = xd0ft
                    If xdmi = xd0rg Then Sheets(xdb).Cells(xdl, 12) = "Vu": xdv = xd0ft
                    If xdgl = xd0vt Then Sheets(xdb).Cells(xdl, 13) = "OK": xdv = xd0ft
                    If xdgl = xd1vt Then Sheets(xdb).Cells(xdl, 13) = "OK": xdv = xd0ft
                    If xdgl = xd6bl Then Sheets(xdb).Cells(xdl, 15) = "vu": xdv = xd0ft
                End If
            End If
        Next c
    End With
    .AutoFilterMode = False                                 'Enlève le filtre auto
End With
End Sub

[FanClub51]

merci
j'ai modifié la fin comme ceci

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
                If Not xdf Is Nothing Then
                    xdl = xdf.Row
                    If Sheets(xdb).Cells(xdl, 3) = "VU" Then
                        Sheets(xda).Cells(xd, 46).Interior.color = xd0rg
                    Else
                        Sheets(xdb).Cells(xdl, 3) = "VU"
                        Sheets(xdb).Cells(xdl, 4) = xdnam
                        Sheets(xdb).Cells(xdl, 5) = xdusn
                        Sheets(xdb).Cells(xdl, 6) = xdlau
                        Sheets(xdb).Cells(xdl, 7) = xddel
                        Sheets(xdb).Cells(xdl, 8) = xdtri
                        Sheets(xdb).Cells(xdl, 9) = xdcha
                        Sheets(xdb).Cells(xdl, 10) = xdhul
                        Sheets(xdb).Cells(xdl, 10).Interior.color = xdhco
                        If xdcgp = xd0vi Then Sheets(xdb).Cells(xdl, 11) = "Vu"
                        If xdcg = xd0vi Then Sheets(xdb).Cells(xdl, 11) = "OK"
                        If xdmi = xd0bl Then Sheets(xdb).Cells(xdl, 12) = "OK"
                        If xdmi = xd1bl Then Sheets(xdb).Cells(xdl, 12) = "OK"
                        If xdmi = xd0or Then Sheets(xdb).Cells(xdl, 12) = "Faire"
                        If xdmi = xd0rg Then Sheets(xdb).Cells(xdl, 12) = "Vu"
                        If xdgl = xd0vt Then Sheets(xdb).Cells(xdl, 13) = "OK"
                        If xdgl = xd1vt Then Sheets(xdb).Cells(xdl, 13) = "OK"
                        If xdgl = xd6bl Then Sheets(xdb).Cells(xdl, 15) = "vu"
                        Sheets(xda).Cells(xd, 46).Interior.color = xd0ft
                    End If
                Else
                    Sheets(xda).Cells(xd, 46).Interior.color = xd0rg
                End If
            End If
        Next c
    End With
    .AutoFilterMode = False                                 'Enlève le filtre auto
End With
Worksheets(xda).Range("A1").AutoFilter
End Sub

premiere tentative lancé depuis la fenetre excel : un gros crash
deuxieme depuis VB (F5) : OK
troisieme depuis excel (VB fermé) : OK
c'est plutot rapide...
merci beaucoup