Toujours trie pair impair

[Temjeh]

Bonjour et merci d'avance

J'aimerais faire un trie pair impair sur 18 lignes sur colonne B avec des valeurs sur colonne A à i sur l'activecell.row à activecell.row + 18

Si vous avec un bout de solution en vba

Merci

Temjeh

 

[jmps]

Re : Toujours trie pair impair

Bonjour et merci d'avance

J'aimerais faire un trie pair impair sur 18 lignes sur colonne B avec des valeurs sur colonne A à i sur l'activecell.row à activecell.row + 18

Si vous avec un bout de solution en vba

Merci

Temjeh

Bonjour Temjeh,

Dit comme ça, j'ai un peu de mal à faire le tri dans ma tête 😀.
C'est un peu comme si tu décrivais un tableau de Picasso à un aveugle 😛
Un petit fichier exemple avec le résultat souhaité serait le bienvenu.

 

[Temjeh]

Re : Toujours trie pair impair

Merci désolé

Voici une idée basic pour trie colonne B
Les lignes peuvent être variable c'est pour ca que j'ai dit de l'activecell.row à activecell.row + 18 car le bloc de donnée ne dépasse jamais 18 lignes donc pas de trie sur feuille complète

Temjeh

 

[Etienne2323]

Re : Toujours trie pair impair

Salut Temjeh,
voici une solution.

Sub Test()

Dim Val_Pair(1 To 100) As Variant
Dim Val_Impair(1 To 100) As Variant
Dim i As Integer, Compteur_Pair As Integer, Compteur_Impair As Integer
Dim DL As Integer

Compteur_Pair = 0
Compteur_Impair = 0

DL = Cells(65536, 2).End(xlUp).Row
For i = 1 To DL
    Select Case Right(Cells(i, 2), 1)
        Case 0, 2, 4, 6, 8
            Compteur_Pair = Compteur_Pair + 1
            Val_Pair(Compteur_Pair) = Cells(i, 2).Value
        Case Else
            Compteur_Impair = Compteur_Impair + 1
            Val_Impair(Compteur_Impair) = Cells(i, 2).Value
    End Select
Next i

Range(Cells(1, 2), Cells(DL, 2)).ClearContents

For i = 1 To Compteur_Pair
    Cells(i, 2).Value = Val_Pair(i)
Next i

DL = Cells(65536, 2).End(xlUp).Row
For i = 1 To Compteur_Impair
    Cells(i + DL, 2).Value = Val_Impair(i)
Next i

End Sub

Cordialement,

Étienne

 

[Temjeh]

Re : Toujours trie pair impair

Merci beaucoup Étienne ca fonctionne
Mais est-ce possible de faire suivre les données car j'ai des valeurs dans Col A à Col i ...voir classeur demo.

Merci

Temjeh

 

[Etienne2323]

Re : Toujours trie pair impair

Salut Temjeh,
en fait, il suffit de faire un tablo à deux dimensions.

Voici.

Sub Test()

Dim Val_Pair(1 To 100, 1 To 100) As Variant
Dim Val_Impair(1 To 100, 1 To 100) As Variant
Dim i As Integer, Compteur_Pair As Integer, Compteur_Impair As Integer
Dim DL As Integer

Compteur_Pair = 0
Compteur_Impair = 0

DL = Cells(65536, 2).End(xlUp).Row
For i = 1 To DL
    Select Case Right(Cells(i, 2), 1)
        Case 0, 2, 4, 6, 8
            Compteur_Pair = Compteur_Pair + 1
            For j = 1 To 9
                Val_Pair(Compteur_Pair, j) = Cells(i, j).Value
            Next j
            
        Case Else
            Compteur_Impair = Compteur_Impair + 1
            For j = 1 To 9
                Val_Impair(Compteur_Impair, j) = Cells(i, j).Value
            Next j
    End Select
Next i

Cells.ClearContents

For i = 1 To Compteur_Pair
    For j = 1 To 9
        Cells(i, j).Value = Val_Pair(i, j)
    Next j
Next i

DL = Cells(65536, 2).End(xlUp).Row
For i = 1 To Compteur_Impair
    For j = 1 To 9
        Cells(i + DL, j).Value = Val_Impair(i, j)
    Next j
Next i

End Sub

Cordialement,

Étienne

 

[Temjeh]

Re : Toujours trie pair impair

Parfait! Bravo
Merci beaucoup je modifie pour l'adapté

A++

Temjeh

 

[Temjeh]

Re : Toujours trie pair impair

Bonjour
Mes lignes étant variable ou est mon erreur car il trie correct mais il me supprime toutes mes lignes (g pour ligne et g+18):
l'erreur semble venir de la dernière partie

g = ActiveCell.Row
Dim Val_Pair(1 To 100, 1 To 100) As Variant
Dim Val_Impair(1 To 100, 1 To 100) As Variant
Dim k As Integer, Compteur_Pair As Integer, Compteur_Impair As Integer
Dim DL As Integer

Compteur_Pair = 0
Compteur_Impair = 0

DL = Cells(g + 18, 2).End(xlUp).Row
For i = g To DL
Select Case Right(Cells(i, 2), 1)
Case 0, 2, 4, 6, 8
Compteur_Pair = Compteur_Pair + 1
For J = 1 To 9
Val_Pair(Compteur_Pair, J) = Cells(i, J).Value
Next J

Case Else
Compteur_Impair = Compteur_Impair + 1
For J = 1 To 9
Val_Impair(Compteur_Impair, J) = Cells(i, J).Value
Next J
End Select
Next i

Cells.ClearContents

For i = 1 To Compteur_Pair
For J = 1 To 9
Cells(i, J).Value = Val_Pair(i, J)
Next J
Next i

DL = Cells(g + 18, 2).End(xlUp).Row
For i = 1 To Compteur_Impair
For J = 1 To 9
Cells(i + DL, J).Value = Val_Impair(i, J)
Next J
Next i
Merci

 

[Etienne2323]

Re : Toujours trie pair impair

Re,
c'est au niveau de cette ligne

Cells.ClearContents

Il suffit de la remplacer par la plage à supprimer. Par exemple :

Range(Cells(1,1),Cells(18,9)).ClearContents

Bonne continuité,

Étienne

 

[Temjeh]

Re : Toujours trie pair impair

Merci mais je m'enfonce à modifié ...plus je le travail moins il fonctionne!
Ptêtre si on reprend ton code pure avec g= activecell.row et la dernière de la plage activecell.row+18

Merci on y est presque

 

[Etienne2323]

Re : Toujours trie pair impair

Salut Temjeh,
voici le bout de macro légèrement modifié. Je l'ai commenté aussi pour tu puisses bien comprendre ce qui se passe la-dedans. J'ai mis en haut 4 lignes qui seraient modifiables manuellement et qui permettent de paramétrer la plage de travail. (Les colonnes et les lignes).

Sub Test()

Dim Val_Pair(1 To 100, 1 To 100) As Variant
Dim Val_Impair(1 To 100, 1 To 100) As Variant
Dim i As Integer, Compteur_Pair As Integer, Compteur_Impair As Integer
Dim DL As Integer, Col_Gauche As Integer, Col_Droite As Integer, Ligne_Haut As Integer
Dim Ligne_Bas As Integer, Colonne_Du_Tri As Integer

'On initialise les compteurs
Compteur_Pair = 0
Compteur_Impair = 0

'On va aller paramétrer la plage de travail
Col_Gauche = 1
Col_Droite = 9

Ligne_Haut = 1
Ligne_Bas = 18

'La colonne sur laquelle on veut effectuer le TRI
Colonne_Du_Tri = 2

'La boucle For i = --> va nous permettre de boucler de haut en bas notre plage.
For i = Ligne_Haut To Ligne_Bas 'Pour chacune des lignes de notre plage
    Select Case Right(Cells(i, Colonne_Du_Tri), 1) 'S'il s'agit d'un chiffre pair, alors ...
        Case 0, 2, 4, 6, 8
            Compteur_Pair = Compteur_Pair + 1 'On incrémente notre compteur de chiffres pairs
            For j = Col_Gauche To Col_Droite 'Pour chacune des colonnes de notre plage
                Val_Pair(Compteur_Pair, j) = Cells(i, j).Value 'On va conserver dans une variable la valeur de la cellule
            Next j 'Passe à la colonne suivante
            
        Case Else 'S'il s'agit d'un chiffre impair, alors ...
            Compteur_Impair = Compteur_Impair + 1 'On incrémente notre compteur de chiffres impairs
            For j = Col_Gauche To Col_Droite 'Pour chacune des colonnes de notre plage
                Val_Impair(Compteur_Impair, j) = Cells(i, j).Value 'On va conserver dans une variable la valeur de la cellule
            Next j 'Passe à la colonne suivante
    End Select
Next i 'Passe à la ligne suivante

'Comme on a toute notre info dans des variables, on peut libérer la plage. On enlève donc toutes les infos
'qui sont comprises dans notre plage
Range(Cells(Ligne_Haut, Col_Gauche), Cells(Ligne_Bas, Col_Droite)).ClearContents

'On va ensuite ressortir notre information
For i = 1 To Compteur_Pair 'On va commencer par boucler sur tous les chiffres pairs
    For j = Col_Gauche To Col_Droite 'On va boucler toutes les colonnes de notre plage
        Cells(i, j).Value = Val_Pair(i, j) 'On inscrit sur la bonne ligne et sur la bonne colonne l'information
        'contenue dans notre variable tablo à deux dimensions
    Next j 'passe à la prochaine colonne
Next i 'passe à la prochaine ligne

DL = Cells(1, Colonne_Du_Tri).End(xlDown).Row 'On va aller chercher la dernière cellule de chiffres pairs
For i = 1 To Compteur_Impair 'On va boucler sur tous les chiffres impairs ensuite
    For j = Col_Gauche To Col_Droite 'On va boucler toutes les colonnes de notre plage
        Cells(i + DL, j).Value = Val_Impair(i, j) 'On inscrit sur la bonne ligne et sur la bonne colonne l'information
    Next j 'passe à la prochaine colonne
Next i  'passe à la prochaine ligne


End Sub

En espérant que ça t'éclaire un peu,

Cordialement,

Étienne

 

[Temjeh]

Re : Toujours trie pair impair

Merci mais il remet encore le tout au début en A1
regarde ma pièce jointe

A+

Temjeh

 

[Etienne2323]

Re : Toujours trie pair impair

Salut Temjeh,
voici un exemple avec des Inputbox dans ton classeur. Il te suffit de :
1) Après ton double click, sélectionne la première cellule en haut à gauche de la plage et appuie sur Enter
2) Sélectionne la dernière cellule en bas à droite de la plage et appuie sur Enter

Le tour est joué.

Bonne continuité,

Étienne

 

[Temjeh]

Re : Toujours trie pair impair

Wow parfait ....je l'adapte

Merci beaucoup

Temjeh