Formule trier avec 2 critères et ranger par ordre alphabétique

Le 23/10/2021 à 15:25

Bonjour à tous
Je cherche comment procéder pour réaliser le tri d'une plage de cellules (dans l'exemple : A2:C4)
en fonction de 2 critères :
- la couleur de la cellule (bleu ou jaune)
- le nombre de caractères (4 ou 5)

afin qu'elles se range dans les colonnes correspondantes :
bleu - 4 caractères
jaune - 4 caractères
bleu - 5 caractères
jaune - 5 caractères

par ordre alphabétique.

sachant que la plage de cellule (dans l'exemple : A2:C4) pourrait comporter une ou plusieurs cellules vides.

Si jamais il n'est pas possible de prendre la couleur et le nombre de caractères directement comme critères,
les données pourraient éventuellement se présenter sous cette forme :

Comment dois-je m'y prendre svp ?

Ci-joint le fichier d'exemple :

12exemple-tri.xlsx (11.38 Ko)

Le 23/10/2021 à 20:50

Bonsoir Erza,

En retour ton fichier avec l'apport d'une macro adaptée au tableau actuel.

Clic gauche sur le bouton Tri pour la lancer.

22exemple-tri-erza.xlsm (24.66 Ko)

Le 23/10/2021 à 21:43

Wooow, je suis scotchée, c'est trop bien !
Je vais tenter de comprendre ton code et de l'adapter à mon autre fichier.

Merci beaucoup X Cellus

Le 23/10/2021 à 23:13

Bonjour

Bonjour à tous

Une variante.

12exemple-tri-v1.xlsm (26.14 Ko)

Bye !

Le 24/10/2021 à 18:01

Salut à tous,
J'ai essayé d'adapter le code d'X Cellus à mon autre fichier mais sans succès...

Voici les configs de mon autre fichier :
- Il existe toujours le critère de cellule jaune ou bleu
- Je ne recherche plus 4 et 5 caractères mais : 3, 4, 5, 6, 7, 8, 9, 10, 11, 12
- Les mots à ranger ne sont plus en A2:C4 mais en A2:AI1321
- les colonnes de rangement ont été déplacés et adaptées en conséquence

Après de nombreuses bidouilles sur le code de X Cellus, voici ce que ça donne :

Sub TriCoul()
Range("BC2:BL500").ClearContents
For Lig = 2 To 1321
For Col = 1 To 35
If Cells(Lig, Col).Interior.Color = Range("BC1:BL1").Interior.Color Then Coul = 0

Select Case Coul
Case 0
'Couleur Jaune
If Len(Cells(Lig, Col)) = 3 Then Kol = "BC"
If Len(Cells(Lig, Col)) = 4 Then Kol = "BD"
If Len(Cells(Lig, Col)) = 5 Then Kol = "BE"
If Len(Cells(Lig, Col)) = 6 Then Kol = "BF"
If Len(Cells(Lig, Col)) = 7 Then Kol = "BG"
If Len(Cells(Lig, Col)) = 8 Then Kol = "BH"
If Len(Cells(Lig, Col)) = 9 Then Kol = "BI"
If Len(Cells(Lig, Col)) = 10 Then Kol = "BJ"
If Len(Cells(Lig, Col)) = 11 Then Kol = "BK"
If Len(Cells(Lig, Col)) = 12 Then Kol = "BL"
M = Range(Kol & 1321).End(xlUp).Row + 1
Range(Kol & M) = Cells(Lig, Col)
End Select
Next Col
Next Lig

Range("AS2:BB500").ClearContents
For Lig = 2 To 1321
For Col = 1 To 35
If Cells(Lig, Col).Interior.Color = Range("AS1:BB1").Interior.Color Then Coul = 1

Select Case Coul
Case 1
'Couleur Bleu
If Len(Cells(Lig, Col)) = 3 Then Kol = "AS"
If Len(Cells(Lig, Col)) = 4 Then Kol = "AT"
If Len(Cells(Lig, Col)) = 5 Then Kol = "AU"
If Len(Cells(Lig, Col)) = 6 Then Kol = "AV"
If Len(Cells(Lig, Col)) = 7 Then Kol = "AW"
If Len(Cells(Lig, Col)) = 8 Then Kol = "AX"
If Len(Cells(Lig, Col)) = 9 Then Kol = "AY"
If Len(Cells(Lig, Col)) = 10 Then Kol = "AZ"
If Len(Cells(Lig, Col)) = 11 Then Kol = "BA"
If Len(Cells(Lig, Col)) = 12 Then Kol = "BB"
M = Range(Kol & 1321).End(xlUp).Row + 1
Range(Kol & M) = Cells(Lig, Col)
End Select
Next Col
Next Lig

Call TriAnim
End Sub

Sub TriAnim()
'
Application.ScreenUpdating = False
For T = 70 To 74
Cel = Chr(T) & 2 & ":" & Chr(T) & Range(Chr(T) & 1321).End(xlUp).Row
    Range(Cel).Select
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add2 Key:=Range(Cel) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Feuil1").Sort
        .SetRange Range(Cel)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("a1").Select
Next T
Application.ScreenUpdating = True
End Sub

Et ça ne marche pas très bien...

Ce qui marche et ne marche pas pour mes colonnes de rangement :
- Les colonnes bleus contiennent bien les mots selon le nb de caractère et leur couleur (bleu).
Mais. Seule la colonne "AS" est rangé par ordre alphabétique.
Mais. Les colonnes bleues comportent de nombreuses cellules vides (que je souhaiterais supprimer)

- Seule la colonne "BC" (jaune) contient bien les mots selon le nb de caractère et leur couleur (jaune), par ordre alphabétique.
Mais. Les autres colonnes jaunes (de BC à BL) sont en fait les mêmes données que AT à BB (colonne bleu)

Voilà à quoi ça ressemble :

C'est la première fois que je bidouille sur VBA, je suis vraiment désolée que ce soit si brouillon.

Est-ce que quelqu'un pourrait m'aider à réadapter ce code proprement svp ?

Le 24/10/2021 à 19:17

Bonsoir Erza,

Corriger

If Cells(Lig, Col).Interior.Color = Range("BC1:BL1").Interior.Color Then Coul = 0

par

If Cells(Lig, Col).Interior.Color = Range("BC1").Interior.Color Then Coul = 0

car on n'a besoin que de la couleur d'une seule cellule. Ici BC1 devant être bleu.

Le 24/10/2021 à 19:34

Suite,

Ci-dessous c'est adapté pour 4 colonnes. Car Chr(70) permet de cibler la colonne F jusqu'à Chr(74) qui cible la colonne I

For T = 70 To 74
Cel = Chr(T) & 2 & ":" & Chr(T) & Range(Chr(T) & 1321).End(xlUp).Row

Pour cibler des colonnes au delà de Z. Il faut modifier la ligne Cel =

Je teste en fin de soirée.

Le 24/10/2021 à 20:28

A nouveau,

Pour la macro TriAnim. Changer pour la couleur bleu

For T = 45 to 54
Ad = Mid(Cells(1, T).Address, 2, 2)
Cel = Ad & 2 & ":" & Ad & Range(Ad & 1321).End(xlUp).Row

Et pour l'autre couleur.

For T = 55 to 64
Ad = Mid(Cells(1, T).Address, 2, 2)
Cel = Ad & 2 & ":" & Ad & Range(Ad & 1321).End(xlUp).Row

Pour la macro TriCoul.

Faire attention aux cellules qui sont vides. Sinon elles seront intégrées dans les colonnes supérieures à AR

Donc pour les deux couleurs

if Cells(Lig,Col) <>"" then Range(Kol & M) = Cells(Lig, Col)

Le 24/10/2021 à 21:56

Merci X Cellus pour tes réponses !

J'ai modifié le code, mais je ne dois pas bien le faire, je pense que mes lignes ne sont pas bien ordonnées.
Les problèmes sont exactement les mêmes malgré la modification.

Sub TriAnim()
'
Application.ScreenUpdating = False

For T = 45 To 54
Ad = Mid(Cells(1, 45).Address, 2, 2)
Cel = Ad & 2 & ":" & Ad & Range(Ad & 1321).End(xlUp).Row
Next T

For T = 55 To 64
Ad = Mid(Cells(1, 64).Address, 2, 2)
Cel = Ad & 2 & ":" & Ad & Range(Ad & 1321).End(xlUp).Row
Next T

Range(Cel).Select
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add2 Key:=Range(Cel) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Feuil1").Sort
        .SetRange Range(Cel)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("a1").Select

Application.ScreenUpdating = True
End Sub

Sub TriCoul()
Range("BC2:BL500").ClearContents
For Lig = 2 To 1321
For Col = 1 To 35
If Cells(Lig, Col).Interior.Color = Range("BC1").Interior.Color Then Coul = 0

Select Case Coul
Case 0
'Couleur Jaune
If Len(Cells(Lig, Col)) = 3 Then Kol = "BC"
If Len(Cells(Lig, Col)) = 4 Then Kol = "BD"
If Len(Cells(Lig, Col)) = 5 Then Kol = "BE"
If Len(Cells(Lig, Col)) = 6 Then Kol = "BF"
If Len(Cells(Lig, Col)) = 7 Then Kol = "BG"
If Len(Cells(Lig, Col)) = 8 Then Kol = "BH"
If Len(Cells(Lig, Col)) = 9 Then Kol = "BI"
If Len(Cells(Lig, Col)) = 10 Then Kol = "BJ"
If Len(Cells(Lig, Col)) = 11 Then Kol = "BK"
If Len(Cells(Lig, Col)) = 12 Then Kol = "BL"
M = Range(Kol & 1321).End(xlUp).Row + 1
Range(Kol & M) = Cells(Lig, Col)
End Select
Next Col
Next Lig

Range("AS2:BB500").ClearContents
For Lig = 2 To 1321
For Col = 1 To 35
If Cells(Lig, Col).Interior.Color = Range("AS1").Interior.Color Then Coul = 1

Select Case Coul
Case 1
'Couleur Bleu
If Len(Cells(Lig, Col)) = 3 Then Kol = "AS"
If Len(Cells(Lig, Col)) = 4 Then Kol = "AT"
If Len(Cells(Lig, Col)) = 5 Then Kol = "AU"
If Len(Cells(Lig, Col)) = 6 Then Kol = "AV"
If Len(Cells(Lig, Col)) = 7 Then Kol = "AW"
If Len(Cells(Lig, Col)) = 8 Then Kol = "AX"
If Len(Cells(Lig, Col)) = 9 Then Kol = "AY"
If Len(Cells(Lig, Col)) = 10 Then Kol = "AZ"
If Len(Cells(Lig, Col)) = 11 Then Kol = "BA"
If Len(Cells(Lig, Col)) = 12 Then Kol = "BB"
M = Range(Kol & 1321).End(xlUp).Row + 1
Range(Kol & M) = Cells(Lig, Col)
End Select
Next Col
Next Lig

If Cells(Lig, Col) <> "" Then Range(Kol & M) = Cells(Lig, Col)

Call TriAnim
End Sub

Je pense que c'est un peu trop dur pour moi et ma non-expérience en VBA.
Je ne sais pas où placer correctement chaque ligne. J'y vais à l'instinct

Le 24/10/2021 à 23:25

A nouveau,

Revoir la correction de mon message de 20h38 concernant la macro TriAnim.

J'avais laissé les numéros de première colonne et de la dernière dans le code pour tester. Il faut inscrire Cells(1,T).address au lieu de Cells(1,45) pour la première couleur et au lieu de Cells(1,64)

Ensuite ne pas oublier de traiter les cellules vides pour les 2 couleurs comme précisé. Donc aussi pour la couleur Jaune.

Le 25/10/2021 à 11:04

Merci beaucoup X Cellus.
Grâce à ton aide, j'y suis enfin parvenue !

Le 25/10/2021 à 11:10

Si jamais quelqu'un en a besoin un jour, voici ce que ça donne sur une application plus étendue :

Sub TriAnim()

Application.ScreenUpdating = False

For T = 45 To 54
Ad = Mid(Cells(1, T).Address, 2, 2)
Cel = Ad & 2 & ":" & Ad & Range(Ad & 1321).End(xlUp).Row
Next T

For T = 55 To 64
Ad = Mid(Cells(1, T).Address, 2, 2)
Cel = Ad & 2 & ":" & Ad & Range(Ad & 1321).End(xlUp).Row
Next T

Range(Cel).Select
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add2 Key:=Range(Cel) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Feuil1").Sort
        .SetRange Range(Cel)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("a1").Select

Application.ScreenUpdating = True
End Sub

Sub TriCoul()
Range("AS2:BB500").ClearContents
For Lig = 2 To 1321
For Col = 1 To 35
If Cells(Lig, Col).Interior.Color = Range("BC1").Interior.Color Then Coul = 1
If Cells(Lig, Col).Interior.Color = Range("AS1").Interior.Color Then Coul = 2
Select Case Coul
Case 1
'Couleur Jaune
If Len(Cells(Lig, Col)) = 3 Then Kol = "BC"
If Len(Cells(Lig, Col)) = 4 Then Kol = "BD"
If Len(Cells(Lig, Col)) = 5 Then Kol = "BE"
If Len(Cells(Lig, Col)) = 6 Then Kol = "BF"
If Len(Cells(Lig, Col)) = 7 Then Kol = "BG"
If Len(Cells(Lig, Col)) = 8 Then Kol = "BH"
If Len(Cells(Lig, Col)) = 9 Then Kol = "BI"
If Len(Cells(Lig, Col)) = 10 Then Kol = "BJ"
If Len(Cells(Lig, Col)) = 11 Then Kol = "BK"
If Len(Cells(Lig, Col)) = 12 Then Kol = "BL"
M = Range(Kol & 1321).End(xlUp).Row + 1
If Cells(Lig, Col) <> "" Then Range(Kol & M) = Cells(Lig, Col)
End Select

Select Case Coul
Case 2
'Couleur Bleu
If Len(Cells(Lig, Col)) = 3 Then Kol = "AS"
If Len(Cells(Lig, Col)) = 4 Then Kol = "AT"
If Len(Cells(Lig, Col)) = 5 Then Kol = "AU"
If Len(Cells(Lig, Col)) = 6 Then Kol = "AV"
If Len(Cells(Lig, Col)) = 7 Then Kol = "AW"
If Len(Cells(Lig, Col)) = 8 Then Kol = "AX"
If Len(Cells(Lig, Col)) = 9 Then Kol = "AY"
If Len(Cells(Lig, Col)) = 10 Then Kol = "AZ"
If Len(Cells(Lig, Col)) = 11 Then Kol = "BA"
If Len(Cells(Lig, Col)) = 12 Then Kol = "BB"
M = Range(Kol & 1321).End(xlUp).Row + 1
If Cells(Lig, Col) <> "" Then Range(Kol & M) = Cells(Lig, Col)
End Select
Next Col
Next Lig

Call TriAnim
End Sub

Bon courage à tous !

Le 25/10/2021 à 14:18

Bonjour Erza,

Bien d'avoir proposé ton code étendu ce matin pour les membres ou forumeurs qui seraient intéressé(e)s.

Juste pour cette partie ci-dessous, en Macro TriCoul()

'Couleur Jaune
If Len(Cells(Lig, Col)) = 3 Then Kol = "BC"
If Len(Cells(Lig, Col)) = 4 Then Kol = "BD"
If Len(Cells(Lig, Col)) = 5 Then Kol = "BE"
If Len(Cells(Lig, Col)) = 6 Then Kol = "BF"
If Len(Cells(Lig, Col)) = 7 Then Kol = "BG"
If Len(Cells(Lig, Col)) = 8 Then Kol = "BH"
If Len(Cells(Lig, Col)) = 9 Then Kol = "BI"
If Len(Cells(Lig, Col)) = 10 Then Kol = "BJ"
If Len(Cells(Lig, Col)) = 11 Then Kol = "BK"
If Len(Cells(Lig, Col)) = 12 Then Kol = "BL"

On peut remplacer par ci-dessous afin d'éliminer des conditions IF

Lg = Len(Cells(Lig,Col))
If Lg > 2 And Lg < 13 Then Kol = Mid(Cells(1, 52 + Lg).Address, 2, 2)

Et idem pour le Bleu

Lg = Len(Cells(Lig,Col))
If Lg > 2 And Lg < 13 Then Kol = Mid(Cells(1, 42 + Lg).Address, 2, 2)

Rechercher des sujets similaires à "formule trier criteres ranger ordre alphabetique"