Alléger codes

[ripo]

Bonjour à toutes et à tous,

Il y a quelques temps, j'ai créé un fichier avec macros, mais à force de le faire évoluer, il devient lent!
Je ne sais pas comment m'y prendre pour alléger ces codes.
Merci pour votre aide
Ripo

ci joint les codes... navré, je ne peux pas réduire le fichier à 48ko
_________________________________________________________________________
Private Sub CommandButton1_Click()
Selection.AutoFilter Field:=1
Selection.AutoFilter Field:=2
Selection.AutoFilter Field:=3
Selection.AutoFilter Field:=4
Selection.AutoFilter Field:=5
Selection.AutoFilter Field:=6
Range("B1").Select
RechercheFiltre
ActiveWindow.SmallScroll Down:=-2000
End Sub

Private Sub CommandButton2_Click()
With Sheets("chrono stock")
Selection.AutoFilter Field:=1
Selection.AutoFilter Field:=2
Selection.AutoFilter Field:=3
Selection.AutoFilter Field:=4
Selection.AutoFilter Field:=5
Selection.AutoFilter Field:=6
.Range("B1").Select
.Rows("3:10000").EntireRow.Hidden = False
ActiveWindow.SmallScroll Down:=-2000
End With
End Sub

Private Sub CommandButton3_Click()
Selection.AutoFilter Field:=1
Selection.AutoFilter Field:=2
Selection.AutoFilter Field:=3
Selection.AutoFilter Field:=4
Selection.AutoFilter Field:=5
Selection.AutoFilter Field:=6
Range("A1").Select
RechercheFiltre2
ActiveWindow.SmallScroll Down:=-2000
End Sub

Private Sub CommandButton4_Click()
Selection.AutoFilter Field:=1
Selection.AutoFilter Field:=2
Selection.AutoFilter Field:=3
Selection.AutoFilter Field:=4
Selection.AutoFilter Field:=5
Selection.AutoFilter Field:=6
Selection.AutoFilter Field:=2, Criteria1:="=-----*", Operator:=xlAnd
End Sub
_________________________________________________________________________
Option Explicit
Sub RechercheFiltre2()
Dim Lig As Integer, Plage As Range, Cell As Range, Zone As Range
Dim Msg As String, Style, Title As String, MyValue As Variant
Dim Cible As String, Val As Range

Application.ScreenUpdating = False
With Sheets("chrono stock")
.Rows("3:10000").EntireRow.Hidden = False
' Plage à vérifier
Lig = .Range("A10000").End(xlUp).Row
Set Plage = .Range("A3:A" & Lig)
'Mot à chercher
Cible = InputBox(" Saisir la référence LM à rechercher : ", "FILTRE AUTOMATIQUE", "Ref. LM?")
If Cible = "" Or Cible = "Ref. LM?" Then Exit Sub
'Recherche dans la colonne A
For Each Cell In Plage
Cell.Select
Set Val = Cell.Find(What:=Cible, After:=ActiveCell, LookIn:=xlValues, LookAt:=xlPart)
If Not Val Is Nothing Then
Cell.EntireRow.Hidden = False
Else
Cell.EntireRow.Hidden = True ' Masquer les lignes du tableau
End If
Next
Range("A1").Select
End With
End Sub
___________________________________________________________________________
Option Explicit
Sub RechercheFiltre()
Dim Lig As Integer, Plage As Range, Cell As Range, Zone As Range
Dim Msg As String, Style, Title As String, MyValue As Variant
Dim Cible As String, Val As Range

Application.ScreenUpdating = False
With Sheets("chrono stock")
.Rows("3:10000").EntireRow.Hidden = False
' Plage à vérifier
Lig = .Range("B10000").End(xlUp).Row
Set Plage = .Range("B3:B" & Lig)
'Mot à chercher
Cible = InputBox(" Saisir toute ou partie de la désignation à rechercher : ", "FILTRE AUTOMATIQUE", "désignation?")
If Cible = "" Or Cible = "désignation?" Then Exit Sub
'Recherche dans la colonne B
For Each Cell In Plage
Cell.Select
Set Val = Cell.Find(What:=Cible, After:=ActiveCell, LookIn:=xlValues, LookAt:=xlPart)
If Not Val Is Nothing Then
Cell.EntireRow.Hidden = False
Else
Cell.EntireRow.Hidden = True ' Masquer les lignes du tableau
End If
Next
Range("B1").Select
End With
End Sub
_______________________________________________________________________
Sub Macro1()
'
' Macro1 Macro
' Macro enregistrée le 14/06/2008 par ripo'

'
Selection.AutoFilter Field:=1
Selection.AutoFilter Field:=2
Selection.AutoFilter Field:=3
Selection.AutoFilter Field:=4
Selection.AutoFilter Field:=5
Selection.AutoFilter Field:=6
End Sub
___________________________________________________________________________
Option Explicit
Dim vNow As Variant

 

[tototiti2008]

Re : Alléger codes

Bonsoir ripo,

trés joli code... mais si tu nous expliquais le but de chaque procédure, parce que sans fichier de données, ça ne peut que rester trés flou pour nous...

 

[Luki]

Re : Alléger codes

Bonsoir Ripo et tototiti,

Ripo, tu dis : "il devient lent". Quoi donc, l'exécution des macros? l'ouverture et l'enregistrement du fichier? C'est pas pareil....😱
A+

 

[kjin]

Re : Alléger codes

Bonsoir, bonsoir tototiti,
J'y comprends pas plus néanmoins

'....
' Plage à vérifier
Lig = .Range("B10000").End(xlUp).Row
Set Plage = .Range("B3:B" & Lig)
'Mot à chercher
Cible = InputBox(" Saisir toute ou partie de la désignation à rechercher : ", "FILTRE AUTOMATIQUE", "désignation?")
If Cible = "" Or Cible = "désignation?" Then Exit Sub
'Recherche dans la colonne B
For Each Cell In Plage
Cell.Select
Set Val = Cell.Find(What:=Cible, After:=ActiveCell, LookIn:=xlValues, LookAt:=xlPart)
If Not Val Is Nothing Then
Cell.EntireRow.Hidden = False
'....

Puisque tu recherches les cellules contenant la valeur "Cible" pourquoi ne pas simplement écrire

'....
' Plage à vérifier
Lig = .Range("B10000").End(xlUp).Row
Set Plage = .Range("B3:B" & Lig)
'Mot à chercher
Cible = InputBox(" Saisir toute ou partie de la désignation à rechercher : ", "FILTRE AUTOMATIQUE", "désignation?")
If Cible = "" Or Cible = "désignation?" Then Exit Sub
'Recherche dans la colonne B
For Each Cell In Plage
If Cell = Cible Then Cell.EntireRow.Hidden = False
'....

A+
kjin

 

[tototiti2008]

Re : Alléger codes

Bonsoir kjin,

et puis

Selection.AutoFilter Field:=1
Selection.AutoFilter Field:=2
Selection.AutoFilter Field:=3
Selection.AutoFilter Field:=4
Selection.AutoFilter Field:=5
Selection.AutoFilter Field:=6

ne peut-il être remplacé par

ActiveSheet.ShowAllData

ou quelque chose du genre ?

 

[kjin]

Re : Alléger codes

Re, bonsoir luki,
A y être

Sub RechercheFiltre2()
Dim Lig As Integer, Plage As Range, Cell As Range, Zone As Range
Dim Msg As String, Style, Title As String, MyValue As Variant
Dim Cible As String, Val As Range

Application.ScreenUpdating = False
With Sheets("chrono stock")
.Rows("3:10000").EntireRow.Hidden = False
' Plage à vérifier
Lig = .Range("A10000").End(xlUp).Row
Set Plage = .Range("A3:A" & Lig)
'Mot à chercher
Cible = InputBox(" Saisir la référence LM à rechercher : ", "FILTRE AUTOMATIQUE", "Ref. LM?")
If Cible = "" Or Cible = "Ref. LM?" Then Exit Sub
'Recherche dans la colonne A
Plage.AutoFilter Field:=1, Criteria1:=Cible
End With
End Sub

A+
kjin

 

[ripo]

Re : Alléger codes

tototiti2008,Luki,Kjin,le forum... merci.
Ci joint fichier allégé avec explications
Merci de votre contribution
A+
Ripo

 

[kjin]

Re : Alléger codes

Bonjour,
Un essai avec ce que j'ai compris et testé sur 12000 lignes
La recherche par désignation se fait sur un mot (GEO par exemple)
Pour ma part, en ce qui concerne les références, les formats exotiques sont proscrits
A+
kjin

 

[ripo]

Re : Alléger codes

Bonsoir le forum, Kjin

c'est effectivement beaucoup plus simple et surtout plus rapide.
MERCI,
A+