Discussion :

[oscar.cesar]

bonjour
Dans le code suivant (issue du forum apres qql adaptationpour mon programme)
une synthese est realisée avec des series de nombres seulement la synthese effectue un classement des nombres de la serie et les recopie dans la feuille"resultat".

ex : si serie1 =8-9-1-3 et serie2 = 2-1-10-4 alors apres synthese
le resultat est de 1-2-3-4-8-9-10 alors que l'ordre des nombres dans les series1 et 2 devrait plustot donner 1-8-9-3-2-10-4.

seulement je n'ai sais pas faire .

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
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
 
Public Sub synthese() 'synthese par freq d'apparition
 
Dim freq() As Integer
Dim icol As Integer, iLigne As Integer
Dim i As Integer
Dim taillejeu As Integer
 
 
Sheets("synthese").Range("A2:U2").Clear 'efface la zone de calcul synthese en A2 à T20
 
icol = 2
iLigne = 6
If Sheets("synthese").Range("B6").Value = "" Then 'test erreur à finir
MsgBox "attention pas de prono selectione"
End
End If
 
ReDim freq(0)
 
Do While Sheets("synthese").Range("B" & iLigne).Value <> ""
icol = 2
 
Do While Sheets("synthese").Cells(iLigne, icol).Value <> ""
'Regarde si la valeur rentre dans le tableau
If UBound(freq) < Sheets("synthese").Cells(iLigne, icol).Value Then
ReDim Preserve freq(Sheets("synthese").Cells(iLigne, icol).Value)
End If
 
freq(Sheets("synthese").Cells(iLigne, icol).Value) = freq(Sheets("synthese").Cells(iLigne, icol).Value) + 1
 
icol = icol + 1
Loop
 
iLigne = iLigne + 1
Loop
 
'Insere les infos ligne 18
 
icol = 21
iLigne = 22
 
 
For i = 0 To UBound(freq)
 
If freq(i) > 0 Then
'Infos num avec frequence
Sheets("synthese").Cells(2, icol).Value = i & "(" & freq(i) & ")"
icol = icol + 1
Sheets("synthese").Cells(iLigne, 3).Value = i
Sheets("synthese").Cells(iLigne, 4).Value = freq(i)
iLigne = iLigne + 1
End If
 
Next i
Sheets("synthese").Activate
'Tri les infos
Sheets("synthese").Cells(22, 4).Select
Selection.CurrentRegion.Select
Selection.Sort Key1:=Sheets("synthese").Range("D22"), Order1:=xlDescending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
 
'Copie les infos
Sheets("synthese").Range("C22:C" & iLigne).Select
Selection.Copy
'demarre l'affichage de la synthese en A2
Sheets("synthese").Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
 
Sheets("synthese").Cells(22, 4).Select
Selection.CurrentRegion.Select
Selection.Clear
 
Sheets("synthese").Range("A1").Select
 
'recopie le resultat de la synthese de la feuille "synthese" dans la feuille resultat à partie de F à U , nombre classe du plus petit au plus grand
Sheets("résultat").Range("F" & ir & ":U" & ir).Value = Sheets("synthese").Range("A2:T2").Value
Sheets("résultat").Range("A" & ir).Value = indexcourse 'ecrire l'index de la course dans la feuil resultat
End Sub

merci

[oscar.cesar]

bonjour
merci pour le code mais justement , je ne veux pas faire de tri croissant.
si je pouvais avoir qql explication sur le code de tri

merci

[ouskel'n'or]

Première série sur ligne 6 : 8_9_1_3
Seconde série sur ligne 7 : 2_1_10_4
Résultat sur ligne 8

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
Sub TestAvec8_9_1_3et2_1_10_4()
Dim Collect As New Collection, i, j, k
Dim NbCol As Byte
NbCol = 4
    For i = 2 To NbCol +1
        Collect.Add (Cells(6, i).Value)
    Next
    For i = 2 To NbCol +1
        Collect.Add (Cells(7, i).Value)
    Next
    i = 0
    For i = Collect.Count - NbCol To 1 Step -1 'Où 4 représente le début de la seconde série
        k = Collect.Count
        For j = k To NbCol + 1 Step -1
            If Collect(i) = Collect(j) Then
                Collect.Remove j
                Exit For
            End If
        Next
    Next
    'Lecture sans doublon (à coller ligne 2)
    For i = 1 To Collect.Count
        Cells(8, i + 1) = Collect(i)
    Next
End Sub

Il y plus simple avec deux tableaux mais je n'ai pas voulu ré-écrire le code

[oscar.cesar]

bonsoir à tous , ouskel'n'or

voila le code que j'ai qql peu modifie avec l'aide du forum . encore merci

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
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
 
'synthese de serie en les mettant à la suite et en supprimant les doublons mais sans tenir compte de la freq d'apparition dans chque serie
Dim Collect As New Collection, i, j, k
Dim indexlignelecturepronosynthese, colonne, dernierecolonne As Integer
Dim NbCol As Byte
 
 
Sheets("feuil6").Range("A9:AA65536").Clear 'efface le resultat de la synthese
 
NbCol = ExtraireChiffres(chn) - 1 'appel la function CHN et la transforme par la fonction extrairechiffres ,cela extrait le n° de la colonne
 
 
 
 
indexlignelecturepronosynthese = 6
 
 
Do While Sheets("feuil6").Range("B" & indexlignelecturepronosynthese).Value <> "" 'test ligne vide
 
         For i = 2 To NbCol + 1
              Collect.Add (Cells(indexlignelecturepronosynthese, i).Value) ' lecture de chaque serie à partir de la  ligne 6 a partir de la colonne 2
         Next
 
    i = 0
    indexlignelecturepronosynthese = indexlignelecturepronosynthese + 1
Loop
 
 
 
    For i = Collect.Count - NbCol To 1 Step -1  'Où 4 représente le début de la seconde série
        k = Collect.Count
        For j = k To NbCol + 1 Step -1
            If Collect(i) = Collect(j) Then
                Collect.Remove j
                Exit For
            End If
        Next
    Next
    'Lecture sans doublon (à coller ligne 2)
    For i = 1 To Collect.Count
        Cells(10, i + 1) = Collect(i) 'affichage du resultat de  la synthese des 2 serie un supprimant les doublons
    Next
 
 
End Sub
 
 
Function chn() As String
'Fonction qui permet de retrouver la dernière cellule occupée
    Dim DerCell As Range
    Dim derLi, derCol
 
    On Error GoTo fin
    derLi = Cells.Find("*", [B6], , , 1, 2).Row
    derCol = Cells.Find("*", [B6], , , 2, 2).Column
    Set DerCell = Cells(derLi, derCol)
 
    chn = DerCell.Address
 
    Exit Function
fin:
    Set DerCell = Cells(1, 1)
    chn = DerCell.Address
End Function

Mais un detail que j'avais pas vu.
la longueur de mes series peut etre differents et la , le programme ZAP des chiffres d'une des series.
ex: serie1=> 8-9-1-3-12-22-25 et serie 2 => 2-1-4 dans ce cas le chiffre 25 est zappe

ou serie1=> 8-9-1 et serie 2 => 2-1-4-3-12-22-25 dans ce cas j'ai tout les chiffres mais avec un espace de 3 cellule vide entre la synthese des 2 serie


Comme je calcul la derniercolonne via la function suivante(issue du forum)sur la derniere ligne qui contient la derniere serie.

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
 
Function chn() As String
'Fonction qui permet de retrouver la dernière cellule occupée
    Dim DerCell As Range
    Dim derLi, derCol
 
    On Error GoTo fin
    derLi = Cells.Find("*", [B6], , , 1, 2).Row
    derCol = Cells.Find("*", [B6], , , 2, 2).Column
    Set DerCell = Cells(derLi, derCol)
 
    chn = DerCell.Address
 
    Exit Function
fin:
    Set DerCell = Cells(1, 1)
    chn = DerCell.Address
End Function

il est logique qu'il y a un impact si les serie sont de longueur differentes .

idem si le nombre de serie est variable.La c'est pire, la serie qui se trouve entre la premiere serie et la derniere serie est ZAppée (dans le cas de 3 series)????

y aurait il une solution ?

merci

[ouskel'n'or]

En reprenant mon code : On fixe le nombre de colonnes le plus important et le moins important.
On crée la collection complète
On passe en revue la collection en partant de la plus longue à la plus courte.
J'ai inversé les lignes et le résultat conserve le bon ordre et réalise le bon tri.

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
Sub TestAvec_8_9_1_et_2_1_4_3_12_22_25()
Dim Collect As New Collection, i, j, k
Dim NbCol As Byte
NbColPlus = 7
NbColMoins = 3
    For i = 2 To NbColPlus + 1
        If Cells(6, i) <> "" Then Collect.Add (Cells(6, i).Value)
    Next
    For i = 2 To NbColPlus + 1
        If Cells(7, i) <> "" Then Collect.Add (Cells(7, i).Value)
    Next
    i = 0
    For i = Collect.Count - NbColPlus To 1 Step -1
        k = Collect.Count
        For j = k To NbColMoins + 1 Step -1
            If Collect(i) = Collect(j) Then
                Collect.Remove j
                Exit For
            End If
        Next
    Next
    'Lecture sans doublon (à coller ligne 2)
    For i = 1 To Collect.Count
        Cells(8, i + 1) = Collect(i)
        Debug.Print Collect(i)
    Next
End Sub

Je te laisse adapter

[oscar.cesar]

bonsoir
ok je regarde
mais question bete, Dans le cas ou le nombre de serie est superieure à 2 .
ou plus precisement le nb de serie est variable (parfois au nombre de 1 à 5 ou 6)?????

[ouskel'n'or]

mais question bete, Dans le cas ou le nombre de serie est superieure à 2 .
ou plus precisement le nb de serie est variable (parfois au nombre de 1 à 5 ou 6)?????

Pour ce soir, tu n'aurais pas une autre question, parce que là je fatigue un peu. Je verrais bien une question sur le dernier N° de colonne renseigné d'une plage ou un N° de première ligne vide... Non ? Tu as déjà posé la question ? Zut !
Bon ! Si tu n'as vraiment rien d'autre à demander, je peux déjà te dire que la méthode que je t'ai donnée n'est plus la bonne, sauf à conserver la collection triée après chaque nouvelle ligne et la comparer à la ligne suivante.
En gros, tu tries deux lignes, tu ajoutes la ligne suivante à la collection, tu retries, et ainsi de suite.
Après les deux premières lignes, à la place de ColPlus = le nombre de colonnes de la ligne la plus longue, tu mets ColPlus = Collect.count et tu ajoutes la ligne suivante à la collection. Ceci en supposant que l'indice de la collection soit supérieur au nombre de cellule de la ligne suivante... Sinon tu fais l'inverse. Bref, tu vas devoir créer une fonction qui fait le trie. La procédure se contentera de gérer les lignes ColPlus et ColMoins. Quand à la collection, il serait intéressant de savoir si on peut la passer en paramètre à une fonction. Sinon, il faudra l'insérer en dur une fois triée, entre chaque ligne... ou la déclarer en public... Je réfléchis en écrivant, tu verras ce qu'il est possible de faire... Quant à moi, ce soir je plie !
A+