Discussion :

[hologram]

Bonjour,

Je m'essaie au macro excel . Je connais moyenement vba word 2007 .

J'ai créé une macro sur base d'une sélection faite à la souris pour trier sur base des colonnes A et D.

Je voudrais automatiser ce texte pour qu'il tienne compte de chaque sélection souris que j'effectue.

Voici le texte de la macro:

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range("A9:A14") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range("D 9 : D 14") _ (j'ai mis des espaces pour éviter les smileys dans mon message...)
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Feuil1").Sort
        .SetRange Range("A9:G14")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

Merci d'avance

[gbbtt]

Bonjour,

Je suis pas sur d'avoir compris la demande donc je vais reformuler ce que j'ai compris:

Tu souhaites sélectionner une plage, lancer la macro et que le tri s'effectue sur la plage sélectionnée uniquement.

C'est bien ça? ou je suis complètement à coté?

Guillaume

[hologram]

C'est exactement cela.

J'ai une feuille avec des tableaux que j'actualise en rajoutant ou retirant des lignes.

Le nombre de colonnes reste identique dans tous les tableaux mais le nombre de ligne peut changer. La place du début du sous-tableau varie en fonction des rajouts des sous-tableaux se trouvant au-dessus.

Merci pour ton aide.

[gbbtt]

Ok alors essaye quelque chose comme ca:

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
 
 
adresse = Selection.Address(False, False)
 
debut = Left(Selection.Address(0, 0), InStr(1, adresse, ":") - 1)
fin = Mid(Selection.Address(0, 0), InStr(1, adresse, ":") + 1, Len(adresse))
debutColonne = Left(debut, 1)
debutLigne = Right(debut, 1)
finColonne = Left(fin, 1)
finLigne = Right(fin, 1)
critere1 = "A" & debutLigne & ":A" & finLigne
critere2 = "A" & debutLigne & ":A" & finLigne
 
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range(critere1), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range(critere2), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
 
    With ActiveWorkbook.Worksheets("Feuil1").Sort
        .SetRange Range(adresse)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

[gbbtt]

Après test, je me suis rendu compte que QuestVba et moi-même avons fait la même erreur de ne prendre que le dernier chiffre pour les lignes
De plus la récupération des colonnes est inutile.
J'ai aussi fait un tri plus propre

Voila donc un code qui doit fonctionner:

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
 
Sub trier()
 
adresse = Selection.Address(False, False)
debutLigne = Selection.Row
fin = Mid(Selection.Address(0, 0), InStr(1, adresse, ":") + 1, Len(adresse))
finLigne = Range(fin).Row
critere1 = "A" & debutLigne & ":A" & finLigne
critere2 = "D" & debutLigne & ":D" & finLigne
 
Range(adresse).Sort _
        Key1:=Range(critere1), Order1:=xlAscending, _
        Key2:=Range(critere2), Order2:=xlAscending, _
        Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
        Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:=xlSortNormal
 
End Sub

[gFZT82]

Bonjour,

Et pour continuer à jouer

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Sub trier()
Dim critere1 As Range, critere2 As Range
Set critere1 = Selection.Resize(, 1)
Set critere2 = Selection.Offset(0, Selection.Columns.Count - 1).Resize(, 1)
Selection.Sort _
        Key1:=critere1, Order1:=xlAscending, _
        Key2:=critere2, Order2:=xlAscending, _
        Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
        Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:=xlSortNormal
Set critere1 = Nothing: Set critere2 = Nothing
End Sub

Cordialement.

[QuestVba]

Bonjour

Essaie ceci

Je prends d'abord la sélection + traitement

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
'Adresse de ta sélection
adress = Selection.Address(0, 0)
'Décomposition et recomposition
deb = Left(Selection.Address(0, 0), InStr(1, Selection.Address(0, 0), ":") - 1)
fin = Mid(Selection.Address(0, 0), InStr(1, Selection.Address(0, 0), ":") + 1, Len(Selection.Address(0, 0)))
debcol = Left(deb, 1)
deblig = Right(deb, 1)
fincol = Left(fin, 1)
finlig = Right(fin, 1)
sel1 = deb & ":" & debcol & finlig
sel2 = fincol & deblig & ":" & fin
    
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range(sel1), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range(sel2), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    
    With ActiveWorkbook.Worksheets("Feuil1").Sort
        .SetRange Range(adress)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With