Simplifier une formule

Version imprimable

1 pièce(s) jointe(s)

Bonjour,
J'ai fais une procédure pour trier des données, elle fonctionne mais je la voit plus que lourde :mouarf:

Code:

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
Sub TriDonnées()
Dim Trouve As Range, PlageDeRecherche As Range
Dim Valeur_Cherchee As String
 
Valeur_Cherchee = "Magasin1"
Set PlageDeRecherche = Worksheets("Données").Range("L3:T14") 'Plage de recherche
Set Trouve = PlageDeRecherche.Cells.Find(what:=Valeur_Cherchee, LookAt:=xlWhole)
 
For GG = 1 To 9
    O = Trouve.Offset(GG, 1).Address 'Cellule "Origine" des données
    ZColonne = Range(O).Column 'Colonne "Origine" des données
    ZLigne = Range(O).Row 'Ligne "Origine" des données
    'Si sur une ligne completement vide alors passe à la suivante
    If Trouve.Offset(GG, 1) = "" Then GoTo suite
 
    For K = ZColonne To (ZColonne + 10) '10=Max colonne des données
        If Cells(ZLigne, K) = "" Then 'si cellule vierge donc fin données sur la ligne
            ZFinale = Cells(ZLigne, K - 1).Address 'Récupère l'adresse de la dernière donnée de la ligne
            Exit For
        End If
    Next K
 
    'Lance le tri
    ActiveWorkbook.Worksheets("Données").Range(O & ":" & ZFinale).Select
    ActiveWorkbook.Worksheets("Données").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Données").Sort.SortFields.Add2 Key:=Range( _
    O & ":" & ZFinale), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
 
    With ActiveWorkbook.Worksheets("Données").Sort
        .SetRange Range(O & ":" & ZFinale)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlLeftToRight
        .SortMethod = xlPinYin
        .Apply
    End With
 
    'Centrage dans les données
    With ActiveWorkbook.Worksheets("Données").Range(O & ":" & ZFinale)
        .Select
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With
 
suite:
Next GG
 
End Sub

Pouvez-vous m'aider pour "l'alléger" ou la simplifier ?

D'avance merci
Christophe

Bonjour,

Essayez ceci

Code:

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
Sub TriDonnées()
    Dim Trouve As Range, PlageDeRecherche As Range
    Dim Valeur_Cherchee As String
    Dim DerLig As Long, O_Lig As Long, O_Col As Long, Lig As Long
 
    Application.ScreenUpdating = False
    Valeur_Cherchee = "Magasin1"
    Set PlageDeRecherche = Worksheets("Données").Range("L3:T14") 'Plage de recherche
    Set Trouve = PlageDeRecherche.Cells.Find(what:=Valeur_Cherchee, LookAt:=xlWhole)
    DerLig = Cells(Trouve.Row, Trouve.Column).End(xlDown).Row
    O_Lig = Trouve.Row + 1 'Ligne "Origine" des données
    O = Trouve.Column 'Colonne des mois
    O_Col = O + 1 'Colonne "Origine" des données
 
    For Lig = O_Lig To DerLig
        DerCol = Cells(Lig, O).End(xlToRight).Column ' Dernière colonne de la ligne traitée
        'Lance le tri
        ActiveWorkbook.Worksheets("Données").Sort.SortFields.Clear
        ActiveWorkbook.Worksheets("Données").Sort.SortFields.Add Key:=Range(Cells(Lig, O_Col), Cells(Lig, DerCol)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With ActiveWorkbook.Worksheets("Données").Sort
            .SetRange Range(Cells(Lig, O_Col), Cells(Lig, DerCol))
            .Header = xlNo
            .MatchCase = False
            .Orientation = xlLeftToRight
            .SortMethod = xlPinYin
            .Apply
        End With
    Next Lig
End Sub

Cdlt

02/05/2020, 15h50
Christophe26

Bonjour,
Super, Merci bien cela fonctionne et effectivement cela réduit considérablement mon code

Juste une chose, comment je peux rajouter une gestion d'erreur si 'Valeur_Cherchee' n'existe pas ?

car si mes employés font une faute d'orthographe alors j'ai erreur (Sur mon code final j'ai un 'Inputbox' pour la recherche de magasin)
il faudrait que si Valeur_Cherchee n'existe pas dans la plage alors retour à l'inputBox

Merci
Christophe

Comme ceci, en rouge

Code:

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
Sub TriDonnées()
    Dim Trouve As Range, PlageDeRecherche As Range
    Dim Valeur_Cherchee As String
    Dim DerLig As Long, O_Lig As Long, O_Col As Long, Lig As Long
    
    Application.ScreenUpdating = False
    Valeur_Cherchee = "Magasin1"
    Set PlageDeRecherche = Worksheets("Données").Range("L3:T14") 'Plage de recherche
    Set Trouve = PlageDeRecherche.Cells.Find(what:=Valeur_Cherchee, LookAt:=xlWhole)
    If Trouve Is Nothing Then Exit Sub
    DerLig = Cells(Trouve.Row, Trouve.Column).End(xlDown).Row
    O_Lig = Trouve.Row + 1 'Ligne "Origine" des données
    O = Trouve.Column 'Colonne des mois
    O_Col = O + 1 'Colonne "Origine" des données
    
    For Lig = O_Lig To DerLig
        DerCol = Cells(Lig, O).End(xlToRight).Column ' Dernière colonne de la ligne traitée
        'Lance le tri
        ActiveWorkbook.Worksheets("Données").Sort.SortFields.Clear
        ActiveWorkbook.Worksheets("Données").Sort.SortFields.Add Key:=Range(Cells(Lig, O_Col), Cells(Lig, DerCol)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With ActiveWorkbook.Worksheets("Données").Sort
            .SetRange Range(Cells(Lig, O_Col), Cells(Lig, DerCol))
            .Header = xlNo
            .MatchCase = False
            .Orientation = xlLeftToRight
            .SortMethod = xlPinYin
            .Apply
        End With
    Next Lig
End Sub

Je suppose que vous avez fait une liste déroulante pour sélectionner le magasin et que vous ne saisissez pas à chaque fois le magasin directement dans le code.

Cdlt

02/05/2020, 17h14
Christophe26

Merci bien ça fonctionne nickel.

Citation:

Envoyé par ARTURO83

Comme ceci, en rouge
Je suppose que vous avez fait une liste déroulante pour sélectionner le magasin et que vous ne saisissez pas à chaque fois le magasin directement dans le code.

Oups et voilà j'étais pris dans mon souci et du coup même pas pensé..
Voilà pourquoi les forums et des personnes tels que vous existent, Merci Merci Merci