Discussion :

[cobra38]

Bonjour à tous,


Je sollicite votre aide car je suis confronté à un probleme de temps de traitement important dans mon application
le but etant tout simplement de reporter dans une feuille le resultat de 2 colonnes en appliquant un filtre à partir d'un resultat de Combobox
voici 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
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
 
Private Sub ComboBox1_Change()
Dim Cherche As String
Dim x As String, x1 As String, y As String
Dim c As Range
 
Unload Fiche
Sheets("BASE").Unprotect Password:="GSR"
 
If Me.ComboBox1.ListIndex > -1 Then
     Cherche = Me.ComboBox1.Value
     Sheets("F").Cells(1, 2) = Cherche
     With Sheets("Base")
       If .AutoFilterMode Then .Range("P2").AutoFilter
         .Range("P2").AutoFilter field:=16, Criteria1:=Me.ComboBox1.Value
        DerLig = .Cells(Rows.Count, "P").End(xlUp).Row
        Application.ScreenUpdating = False
        For Each c In .Range("P2:P" & DerLig).SpecialCells(xlCellTypeVisible)
          x = c.Offset(0, -15) 'Reference
          y = c.Offset(0, -14) 'Complement
          With Sheets("F")
            NoLig = .Range("A65535").End(xlUp).Row + 1
            If NoLig > 3 Then
               .Range(.Cells(NoLig - 1, "A"), .Cells(NoLig - 1, "B")).Copy Destination:=.Cells(NoLig, "A")
            End If
               .Range(.Cells(NoLig, "A"), .Cells(NoLig, "B")).ClearContents
               If x <> x1 Then .Cells(NoLig, "A") = x Else .Cells(NoLig, "A") = "--"
              .Cells(NoLig, "B") = y
 
          End With
          x1 = x
       Next c
      .Range("P2").AutoFilter
    End With
End If
Application.ScreenUpdating = True
MsgBox (" Mise à jour faite !!")
 
 
End Sub

Pour precision : "Base" contient env 6000 lignes et "F" la feuille de report

ce qui aboutit à un temps de traitement très long ( env 3 minutes ? )
j'avoue que mes connaissances en VBA sont tres limités et je ne trouve pas le moyen d'accelerer le temps de traitement
j'ajoute enfin que le prog fonctionne tel quel mais il est beaucoup trop lent

merci en tout cas par avance pour votre aide
A+

[mercatog]

Peut être

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
Private Sub ComboBox1_Change()
Dim DerLig As Long
Dim Cherche As String
 
Application.ScreenUpdating = False
If Me.ComboBox1.ListIndex > -1 Then
    Cherche = Me.ComboBox1.Value
    Unload Fiche
    Sheets("F").Cells(1, 2) = Cherche
    With Sheets("Base")
        .Unprotect Password:="GSR"
        .AutoFilterMode = False
        DerLig = .Cells(.Rows.Count, "P").End(xlUp).Row
        .Range("P2:P" & DerLig).AutoFilter field:=16, Criteria1:=Cherche
        If .Range("P2:P" & DerLig).SpecialCells(xlCellTypeVisible).Count > 1 _
           Then .Range("A3:B" & DerLig).SpecialCells(xlCellTypeVisible).Copy _
           Sheets("F").Cells(.Rows.Count, 1).End(xlUp)(2)
        .AutoFilterMode = False
        .Protect Password:="GSR"
    End With
    MsgBox " Mise à jour faite !!"
End If
End Sub

[cobra38]

Merci mercatog

effectivement y a pas photo !!
le fait de faire une copie entière des cellules filtrées ( si j'ai bien compris )
semble très rapide
J'ai mis aussi "field:= 1 " au lieu de 16 car je ciblais déjà la cellule en "P"
par contre je ne comprends pas le terme (2) utilisé dans
peux-tu m'en dire plus STP

Code :

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

1
2
 
... Sheets("F").Cells(.Rows.Count, 1).End(xlUp)(2)

merci encore de ton aide
A++

[mercatog]

Code :

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

Sheets("F").Cells(.Rows.Count, 1).End(xlUp)(2)

C'est la première cellule vide de la colonne A

[cobra38]

Encore merci mercatog pour tes explications et ton aide
bonne journée

je passe le post en resolu