Discussion :

[marie33000]

Bonjour tous le monde j'aimerais trier mes données d'une certaine façon.
Voici un exemple de mes données:

Code :

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

1
2
3
4
5
6
100		n
100.5		n
101		n+1
101.5		n+1
102		n+2
102.5		n+2

Serait il possible de faire un petit programme pour les trier de cette façon :

Code :

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

1
2
3
4
5
6
100		n
101		n+1
102		n+2
100.5		n
101.5		n+1
102.5		n+2

J'aimerais les trier par groupe de suite arithmétique en fait.

Merci par avance

[Krovax]

Donc si j'ai bien compris on doit commencer par
toruver un n
regarder dans les n+1 celui dont la valeur a une différence proche de 1 (je viens de découvrir la fonction Round )
Le mettre a la suite puis regarde dans les n+2 celui avec une différence de 2,etc....
puis chercher le n suivant

Ta de la chance je sent que l'algo va m'amuser
(je ne garanti par avance pas que ce soit optimal, ni même compréhensible pour un cerveau moins tordu que le mien )

on peux avoir un n+3 sans n+2???
Les données initiales sont toujours trié dans l'ordre?
tu as un n+ maximum?

[marie33000]

Les données sont toujours triés dans l'ordre croissant en effet.
Il peut je pense y avoir n+10 au max.

Oui en fait il faudrait trouver un moyen de regrouper les séquences de mes suites arithmétiques en fait...

Ça m'a pas l'air du tout évident ce genre de trie :s

ps: on ne peut pas avoir de n+3 sans un n+2

[Krovax]

Bon je n'ai pas fait bcp de teste différent mais essaye déjà

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
28
29
30
 
Dim DerniereLigne As Long
Dim i As Long, j As Long
Dim Mn As Double
Dim k As Byte
Dim flag As Boolean
DerniereLigne = Cells(Columns(1).Cells.Count, 1).End(xlUp).Row 'remplace le 1 par le numéro de la colonne
 
 
For i = 1 To DerniereLigne
    If Cells(i, 2) = "n" Then
        Mn = Cells(i, 1)
        k = 1
        Do
        flag = True
            For j = i + k To DerniereLigne
                If Cells(j, 2) = "n+" & k Then
                    If (Cells(j, 1) - Mn) = k Then
                        Rows(i + k).Insert
                        Rows(j + 1).Copy Rows(i + k)
                        Rows(j + 1).Delete
                        k = k + 1
                        flag = False
                        Exit For
                    End If
                End If
            Next j
        Loop Until k > 10 Or flag
    End If
Next i

Il faudra peut être ajouter un

Code :

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

 round(Cells(j, 1) - Mn)=k

si les valeur ne sont pas exacte
ou arrondir a 1 chiffre après la virgule

Code :

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

If round(Cells(j, 1) - Mn,1)=k Then