bonjour,

est-il possible d'accelerer ce code svp :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim maVar1 As String
Dim cel As Range
Application.ScreenUpdating = False
If Not Intersect(Target, Range("$G$1")) Is Nothing Then
End If
Select Case Range("G1").Value
Case 1
Call MasquerLignesSTEA
Case 2
Call MasquerLignesSTES
End Select
Next
Application.ScreenUpdating = True
End Sub

Dans un module :

Sub MasquerLignesSTEA()
Dim ligne As Integer
For Each cel In Range("D5:D35000")
For ligne = 5 To 100
If Cells(ligne, 4) = "STEA" Then
Rows(ligne & ":" & ligne).EntireRow.Hidden = True
End If
Next
Next
Range("A5").Activate
End Sub

Sub MasquerLignesSTES()
Dim ligne As Integer
For Each cel In Range("D5:D35000")
For ligne = 5 To 100
If Cells(ligne, 4) = "STES" Then
Rows(ligne & ":" & ligne).EntireRow.Hidden = True
End If
Next
Next
Range("A5").Activate
End Sub

en vous remerciant

Bizarre ces deux lignes qui se suivent :

If Not Intersect(Target, Range("$G$1")) Is Nothing Then
End If

Quelle durée ?

Et peux-tu préciser plus exactement ce que l'exécution du code doit produire ?

bonjour ferrand,

effectivement, je m'en suis apercu et corrige comme suit :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim maVar1 As String
Dim cel As Range
Application.ScreenUpdating = False
If Not Intersect(Target, Range("$G$1")) Is Nothing Then
Select Case Range("G1").Value
Case 1
Call MasquerLignesSTEA
Case 2
Call MasquerLignesSTES
End Select
Next
End If

Application.ScreenUpdating = True
End Sub

ainsi que :

Dans un module :

Sub MasquerLignesSTEA()
Dim ligne As Integer
For ligne = 5 To 100
If Cells(ligne, 4) = "STEA" Then
Rows(ligne & ":" & ligne).EntireRow.Hidden = True
End If
Next
Range("A5").Activate
End Sub

Sub MasquerLignesSTES()
Dim ligne As Integer
For ligne = 5 To 100
If Cells(ligne, 4) = "STES" Then
Rows(ligne & ":" & ligne).EntireRow.Hidden = True
End If
Next
Range("A5").Activate
End Sub

car j'avais 2 boucles.

le but de ce code, selon valeur en G1, j'appelel le code MasquerLignesSTEA ou MasquerLignesSTES pour masquer des lignes dont la colonne D contient uniquement STEA ou STES, le tout sur environ 35000 lignes.

mais je commence a patauger.

cordialement.

35000 ou 100 ? C'est pas pareil !

100 c'etait pour tester

c'est Ok avec ce code :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim maVar1 As String
Dim cel As Range
Dim ligne As Integer
maVar = "Sélectionnez un concours."
'Désactivation de l'écran
Application.ScreenUpdating = False
Cells.EntireRow.Hidden = False

Select Case Range("$G$1").Value
Case 1
'Call MasquerLignesSTES
For Each cel In Range("D5:D105") 'Plage à adapter
If cel.Value = "STES" Then
cel.EntireRow.Hidden = True
End If
Next


Case 2
'Call MasquerLignesSTEA
For Each cel In Range("D5:D105") 'Plage à adapter
If cel.Value = "STEA" Then
cel.EntireRow.Hidden = True
End If
Next

Case 3
Cells.EntireRow.Hidden = False
Range("A1").Activate

Case Else
Exit Sub
End Select
'Réactivation de l'écran
Application.ScreenUpdating = True
End Sub

Pas vu ta dernière version. Suis sur plusieurs choses en même temps, mais j'avais commencé une simplification du jet précédent :

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$G$1" Then MasquerLignes Target.Value
End Sub

Sub MasquerLignes(s As Integer)
Dim ligne As Long, ste As String
Select Case s
Case 1
ste = "STEA"
Case 2
ste = "STES"
Case Else
Exit Sub
End Select
Application.ScreenUpdating = False
For ligne = 5 To 35000
If Cells(ligne, 4).Value = ste Then Rows(ligne).EntireRow.Hidden = True
Next ligne
Application.ScreenUpdating = True
Range("A5").Activate
End Sub

A voir.

Adaptation rapide prenant en compte tes derniers éléments, dans la structure antérieure (proc. MasquerLignes):

Sub MasquerLignes(s As Integer)
Dim ligne As Long, ste As String
Select Case s
Case 1
ste = "STEA"
Case 2
ste = "STES"
Case 3
Rows.EntireRow.Hidden = False
Exit Sub
Case Else
Exit Sub
End Select
Application.ScreenUpdating = False
Rows.EntireRow.Hidden = False
For ligne = 5 To 35000
If Cells(ligne, 4).Value = ste Then Rows(ligne).EntireRow.Hidden = True
Next ligne
Application.ScreenUpdating = True
Range("A5").Activate
End Sub

On peut sans doute améliorer.

Autres remarques :

Inversion des lignes masquées entre tes deux versions. Choisir la bonne...

MaVar1 n'est pas utilisée dans les deux versions (et dans la seconde tu déclares MaVar1 mais tu affectes MaVar [non déclarée]).

Bonjour ferrand,

je te reponds un peu tardivement, mais j'ai reussi en fait a faire ce que je voulais. merci de t'etre peche sur mon probleme.