Discussion :

[goninph]

Bonjour,

Le but est de vérifier la chronologie des nombres de la colonne filtrée "N°"

J'ai réussi à coder ce que je voulais, mais c'est lent

Comment améliorer la rapidité de ce code ?

Euh pas tout compris, tout à coup le code est hyper rapide

Meilleures salutations

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
 
Private Sub BT_Chronologie_Click()
ThisWorkbook.Activate 'Avec MODAL=FALSE évite que la macro ne se lance sur un autre fichier ouvert
Dim f As Worksheet
Dim Tableau As String
Dim Tableau_Visible As Range
Dim Cellule As Range
Dim Num_Chantier_Precedent As Double
Dim Num_Chantier As Double
Dim Colonne_Check As Range
Dim Chronologie As Range
Dim Nbre_Ligne As Long
Dim Nbre_Ligne_Min As Long
Dim Nbre_Ligne_Max As Long
Dim Cellule_Vide_Num_Chantier As Long
'Application.ScreenUpdating = False
Application.EnableEvents = False ' => reactive les evenements Worksheet_SelectionChange
Application.Calculation = xlManual
    If MsgBox("Vérifier la chronologie des N° chantier ? ", vbYesNo + vbQuestion, "Vérifier") = vbYes Then
        If Application.DisplayFullScreen = False Then Application.DisplayFullScreen = True  ' Affichage plein écran
        Tableau = "TS_Data_Etapes"
        Set f = ThisWorkbook.Sheets("Data_Etapes")
        Nbre_Ligne = f.ListObjects(Tableau).ListColumns("Cmde").DataBodyRange.SpecialCells(xlCellTypeVisible).Count
        Nbre_Ligne_Min = 2
        Nbre_Ligne_Max = 200
        If Nbre_Ligne > Nbre_Ligne_Max Then
            MsgBox Nbre_Ligne & " lignes affichées, le maximum doit être de " & Nbre_Ligne_Max & " lignes", vbExclamation, "! Oups ! Action interrompue"
        ElseIf Nbre_Ligne < Nbre_Ligne_Min Then
            MsgBox Nbre_Ligne & " ligne affichée, le minimum doit être de " & Nbre_Ligne_Min & " lignes", vbExclamation, "! Oups ! Action interrompue"
        Else
            If Application.CountBlank(f.ListObjects(Tableau).ListColumns("N°").DataBodyRange) > 0 Then 'Vérifier si des N° sont manqants
                Cellule_Vide_Num_Chantier = Application.CountBlank(f.ListObjects(Tableau).ListColumns("N°").DataBodyRange)
                MsgBox Cellule_Vide_Num_Chantier & " N° de chantier manquants", vbExclamation, "! Oups ! Action interrompue"
            Else
                Call Filtrer_TS(Range(Tableau), "Système", "<>Text")
                If MsgBox("eta = Oui" & vbLf & vbLf & "eta... = Non", vbYesNo + vbQuestion, "Filtrer") = vbYes Then
                    Call Filtrer_TS(Range(Tableau), "Ext", "eta")
                Else
                    Call Filtrer_TS(Range(Tableau), "Ext", "eta*", xlAnd, "<>eta")
                End If
                Set Tableau_Visible = f.Range(Tableau & "[N°]").SpecialCells(xlCellTypeVisible)
                Set Colonne_Check = f.Range(Tableau & "[Check N°]").SpecialCells(xlCellTypeVisible)
                Call TS_TrierUneColonne(TS:=Range(Tableau), Colonne:="N°", Méthode:=xlSortOnValues, Ordre:=xlAscending, EffacerAncienTri:=True)
                Colonne_Check.Value = "" 'Effacer les valeurs de la colonne
        '        Importer.Importation_Data_Etapes
                For Each Cellule In Tableau_Visible.Cells 'Parcourir les cellules visibles de la colonne "N°"
                    Set Chronologie = Colonne_Check.Cells(Cellule.Row - Tableau_Visible.Cells(1).Row + 1)
                    Num_Chantier = Val(Cellule.Value) * 10 'Convertir le contenu de la cellule en nombre x 10 pour les assemblages xxx.1
                    If Num_Chantier_Precedent = 0 Then
                        Num_Chantier_Precedent = Num_Chantier 'Si c'est la première cellule, conserver sa valeur comme précédent
                    Else
                        If Num_Chantier = Num_Chantier_Precedent Then
                            Chronologie.Value = "Doublon"
                        Else
                            If Cellule.Value = 11 Or Cellule.Value = 101 Or Cellule.Value = 201 Or Cellule.Value = 301 Or Cellule.Value = 401 Or Cellule.Value = 501 Or Cellule.Value = 601 Or Cellule.Value = 701 Or Cellule.Value = 801 Or Cellule.Value = 901 Then
                                Chronologie = 1
                            Else
                                Chronologie.Value = Num_Chantier - Num_Chantier_Precedent 'Soustraire la valeur de la cellule précédente à la suivante
                                If Chronologie.Value = 10 Then
                                    Chronologie.Value = 1
                                Else
                                    If Chronologie.Value <> 1 Then
                                        Chronologie.Value = "A vérifier"
                                    End If
                                End If
                            End If
                            Num_Chantier_Precedent = Num_Chantier 'Mettre à jour la valeur précédente pour la prochaine itération
                        End If
                    End If
                Next Cellule
                MsgBox "Vérification de la chronologie terminée", vbOKOnly + vbInformation, "Info"
                ActiveWindow.ScrollRow = 1
            End If
        End If
    End If
Application.Calculation = xlAutomatic
Application.EnableEvents = True ' => reactive les evenements Worksheet_SelectionChange
'Application.ScreenUpdating = True
End Sub