Microsoft 365 creation petit macro ordre croissant

[blancolie]

Bonsoir le Forum,

Dans ce fichier, j'aimerais avoir dans un module, une petite macro qui rangera mes plantes par ordre croissant quand il y aura un rajout d'une nouvelle plante ( nouvelle ligne)

la colonne à mettre en ordre croissant, c'est la colonne F et à partir de F27. Bien sur, j'espère que cela ne mélangera pas les données à côté.

Pouvez-vous me mettre le code dans votre message si au cas ou je n'arrive pas à ouvrir le fichier.

En vous remerciant d'avance.

Cordialement.

 

[eriiic]

Bonjour,

avec l'enregistreur de macro, un peu remanié :

Sub tri()
    With ActiveWorkbook.Worksheets("BDD_FLEURS").ListObjects("T_Datas").Sort
        .SortFields.Clear
        .SortFields.Add2 Key:=Range("F27"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .Apply
    End With
End Sub

eric

 

[blancolie]

bonsoir,

cette macro trieras en ordre croissant des rajout d'une ligne ?

 

[blancolie]

non cela ne marche pas du tout

 

[soan]

Bonjour blancolie, le fil,

Je te laisse essayer le fichier ci-dessous.

À te lire pour avoir ton avis.

soan

 

[blancolie]

Bonjour Soan et merci

mais cela marche à moitié vu que l'entête se retrouve au milieu de mon tableau

cordialement

 

[eriiic]

Bonjour,

à toi de l'appeler lors du rajout de ligne si c'est fait par macro, ou sur un événement comme quitter la feuille ou autre.
eric

 

[blancolie]

bonsoir eric,

ce que je souhaite, c'est que cela se fasse automatiquement quand je clique sur le bouton copier.

 

[soan]

Bonsoir @blancolie, le fil,

ooooppps ! tu as raison ; essaye avec cet autre fichier ci-dessous.

J'ai changé seulement cette instruction : Range("F25:AJ" & lig).Sort [F25], 1
Je n'ai pas testé, mais en principe, cette fois, ça devrait marcher.

---------------------------------------------------------------------------------

Edit : j'ai supprimé le fichier, car il y avait un bug ;
autre fichier proposé dans le post #11.

soan

 

[blancolie]

la ligne que tu as rajoutée provoque une erreur 1004 : l'élément portant ce nom est introuvable

 

[soan]

Re,

Le tri est fait par une autre méthode ; cette fois, j'ai testé, et ça marche !

Fais un essai : clique sur le bouton « Copier » ➯ ta nouvelle plante carnivore « Crocus
cracoucass (carnivorus) » a été ajoutée sous la dernière ligne du tableau, en ligne 470 ;
puis le tableau a été trié selon le nom de plante, par ordre croissant ➯ la ligne 470 a
été remontée en ligne 121 ; et ton « curseur » va devant cette ligne, en E121.

Essaye de me donner ton avis ... enfin, si tu es saine et sauve, et que tu ne t'es pas fait
bouffer par la plante cracoucass (c'est très dangereux, l'élevage des plantes exotiques,
surtout les plantes carnivores ! ).

Code VBA complet :

Option Explicit

Sub LignePlante()
  If ActiveSheet.Name <> "BDD_FLEURS" Then Exit Sub
  Dim cel As Range, plante$, lig&, b As Byte, i As Byte
  plante = [P9]: If plante = "" Then Exit Sub
  Application.ScreenUpdating = 0: Application.EnableEvents = 0
  Set cel = Columns(6).Find(plante, , -4163, 1, 1)
  If Not cel Is Nothing Then
    lig = cel.Row: b = 1 'plante trouvée
  Else 'plante non trouvée
    lig = ActiveSheet.ListObjects("T_Datas").ListRows.Count + 27
    Cells(lig, 6) = plante                       'Plante
  End If
  With Cells(lig, 6)
    If [P7] <> "" Then .Offset(, 1) = [P7]       'Fournisseur
    If [P11] <> "" Then .Offset(, 7) = [P11]     'Catégorie
    If [P13] <> "" Then .Offset(, 12) = [P13]    'Couleur Fleurs
    If [P15] <> "" Then .Offset(, 11) = [P15]    'Couleurs Feuilles
    If [P17] <> "" Then .Offset(, 14) = [P17]    'Hauteur
    If [P19] <> "" Then .Offset(, 15) = [P19]    'Largeur
    If [P21] <> "" Then .Offset(, 29) = [P21]    'Densité
    If [P23] <> "" Then .Offset(, 16) = [P23]    'Port
    If [W7] <> "" Then .Offset(, 10) = [W7]      'Mellifère
    If [W9] <> "" Then .Offset(, 13) = [W9]      'Inflorescence
    If [W11] <> "" Then .Offset(, 9) = [W11]     'Attrait de la plante
    If [W13] <> "" Then .Offset(, 8) = [W13]     'Contenant
    If [W18] <> "" Then .Offset(, 2) = [W18]     'Marché
    If [AB7] <> "" Then .Offset(, 6) = [AB7]     'Page
    If [AB9] <> "" Then .Offset(, 5) = [AB9]     'numero
    For i = 0 To 11                              'Mois J à D
      If [W16].Offset(, i) <> "" Then .Offset(, 17 + i) = [W16].Offset(, i)
    Next i
  End With
  If b = 0 Then
    With ActiveSheet.ListObjects("T_Datas").Sort
      .SortFields.Clear: .SortFields.Add Range("T_Datas[[#All],[Plante]]"), 0, 1
      .Header = 1: .Apply
    End With
    lig = Columns(6).Find(plante, , -4163, 1, 1).Row
  End If
  Application.Goto Cells(lig, 5), True: Application.EnableEvents = -1
End Sub

Le tri est fait par ces 4 lignes :

With ActiveSheet.ListObjects("T_Datas").Sort
  .SortFields.Clear: .SortFields.Add Range("T_Datas[[#All],[Plante]]"), 0, 1
  .Header = 1: .Apply
End With

soan

 

[eriiic]

Bonjour,

ce que je souhaite, c'est que cela se fasse automatiquement quand je clique sur le bouton copier.

Et bien tu as juste à ajouter tri à la fin de ta macro pour appeler celle-ci.

Ou a ajouter les 8 lignes du code pour l'inclure dans ta macro.
eric

 

[blancolie]

Merci soan et eriic.

cela marche très bien soan. pour ce post.

reste maintenant la discussion du filtrage lol

 

[soan]

@blancolie

Tu as écrit : « cela marche très bien soan. »

Merci pour ta confirmation ! alors tu peux cliquer sur le bouton
« Marquer comme solution » de mon post #11 (c'est possible de
le faire pour plus d'un post ; le fond du post #12 restera vert clair)

(d'habitude, je ne le demande pas ; mais là, c'est parce que le fichier
de mon post #9 était bogué ; je l'ai d'ailleurs supprimé pour ça !)

Pour la discussion du filtrage, j'essayerai plus tard, quand j'aurai
plus de temps (c'est sans garantie, car ton système de page est nouveau ;
alors il faudra d'abord que j'comprenne le mécanisme que tu as utilisé !).

soan

 

[blancolie]

je me suis trompé de post lol