Tri avec conditions

Version imprimable

13/09/2013, 16h46
jacfld49

1 pièce(s) jointe(s)

Tri avec conditions

Bonjour,

je cherche un code pour pouvoir faire un tri du tableau de la feuille 1 en feuille séries avec comme conditions d'avoir le même nombre de personnes dans chaque séries ( ex: 24 personnes donc séries 1, 12 personnes et séries 2 , 12 personnes; Si 23 personnes, séries 1 avec 12 personnes et séries 2 avec 11 personnes) et comme 2ème conditions , équilibrés les personnes d'un même club dans chaque séries ( ex: 4 personnes du club C donc 2 dans chaque séries, si 5 personnes du club B donc 3 dans une série et 2 dans l'autre)
Dans l'exemple joint, j'ai 23 personnes mais je peux avoir au maxi 100 personnes
merci de votre
Jack

Bonsoir,

Une proposition, peut-être à améliorer

Code:

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
Sub repartition()
Dim Dl As Integer, x As Integer, y As Integer, i As Integer
Dim InscritS1(), inscritS2(), S1
With Sheets("Feuil1")
  Dl = .Range("A" & .Rows.Count).End(xlUp).Row
  If WorksheetFunction.IsEven(.Range("A" & Dl)) Then
    S1 = .Range("A" & Dl) / 2
    ReDim InscritS1(1 To S1, 1 To 8): ReDim inscris2(1 To S1, 1 To 8)
  Else
    S1 = Int(.Range("A" & Dl) / 2) + 1
    ReDim InscritS1(1 To S1, 1 To 8): ReDim inscritS2(1 To S1 - 1, 1 To 8)
  End If
  i = 0
  For x = 7 To Dl Step 2
    i = i + 1
    For y = 1 To 8
      If x < Dl Then
        InscritS1(i, y) = .Cells(x, y)
        inscritS2(i, y) = .Cells(x + 1, y)
      Else
        InscritS1(i, y) = .Cells(x, y)
      End If
    Next y
  Next x
End With
With Sheets("Séries")
  .Range("A7").Resize(UBound(InscritS1, 1), UBound(InscritS1, 2)) = InscritS1
  .Range("J7").Resize(UBound(inscritS2, 1), UBound(inscritS2, 2)) = inscritS2
 
End With
End Sub

13/09/2013, 20h05
spookyz

Bonjour à tous,
casefayere jetait dans une usine a gaz avec des boucles et des tableaux en pagaille a chercher un solution et la boum un truc super sauf que je ne le comprend pas pourrait tu s'il te plais et si tu a le temps commenter ce code :ccool:

Voilà, j'espère que ça suffira, sinon n'hésites pas

EDIT : j'ai oublié de dire que j'ai estimé que les données était triées sur la colonne "Club", sinon, il serait facile de le faire, quitte à remettre dans l'ordre initial après l'exécution du code

Code:

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
Sub repartition()
Dim Dl As Integer, x As Integer, y As Integer, i As Integer
Dim InscritS1(), inscritS2(), S1
 
With Sheets("Feuil1")
  Dl = .Range("A" & .Rows.Count).End(xlUp).Row 'donc dernère ligne renseignée
  If WorksheetFunction.IsEven(.Range("A" & Dl)) Then 'si ".Range("A" & Dl)" est un nombre pair
    S1 = .Range("A" & Dl) / 2 'on donne la moitié de la valeur à la variable
    ReDim InscritS1(1 To S1, 1 To 8): ReDim inscritS2(1 To S1, 1 To 8) 'et on redimensionne les 2 tableaux
  Else
    S1 = Int(.Range("A" & Dl) / 2) + 1 'sinon on redimensionne de l'intégrale de la moitié +1
    ReDim InscritS1(1 To S1, 1 To 8): ReDim inscritS2(1 To S1 - 1, 1 To 8) 'et on redimensionne les 2 tableaux
  End If
  i = 0
  For x = 7 To Dl Step 2 'une boucle incrémentée par un pas de 2
    i = i + 1
    For y = 1 To 8 'une autre boucle imbriquée pour parcourir les colonnes
      If x < Dl Then 'si on atteint pas la dernière ligne
      'ci-dessous, on alimente les 2 tableaux pour les 2 dimensions (1 ligne, 8 colonnes)
        InscritS1(i, y) = .Cells(x, y)
        inscritS2(i, y) = .Cells(x + 1, y)
      Else
        InscritS1(i, y) = .Cells(x, y) 'sinon, on alimente que le 1er tableau
      End If
    Next y
  Next x
End With
'enfin ci-dessous, on affecte les résultats obtenus aux tableaux "serie1" et "serie2"
With Sheets("Séries")
  .Range("A7").Resize(UBound(InscritS1, 1), UBound(InscritS1, 2)) = InscritS1 'à partir de A7, on redimensionne le tableau
  .Range("J7").Resize(UBound(inscritS2, 1), UBound(inscritS2, 2)) = inscritS2 'à partir de J7, on redimensionne le tableau
  'pour "Resize", voir l'aide
End With
End Sub

Donc, une variante qui garde les données de "Feuil1" enregistrées comme à l'origine (dans l'éventualité que la ligne "Club" soit dans le désordre)

Code:

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
Option Explicit
Dim TbGeneral, x As Integer, i As Integer, y As Integer
 
Sub repartition()
Dim Dl As Integer, InscritS1(), inscritS2(), S1
With Sheets("Feuil1")
  Dl = .Range("A" & .Rows.Count).End(xlUp).Row 'donc dernère ligne renseignée
  TbGeneral = .Range("A7:H" & Dl)
  Tri_Tableau 'on trie la variable tableau pour laisser les données intactes
  If WorksheetFunction.IsEven(.Range("A" & Dl)) Then 'si ".Range("A" & Dl)" est un nombre pair
    S1 = .Range("A" & Dl) / 2 'on donne la moitié de la valeur à la variable
    ReDim InscritS1(1 To S1, 1 To 8): ReDim inscritS2(1 To S1, 1 To 8) 'et on redimensionne les 2 tableaux
  Else
    S1 = Int(.Range("A" & Dl) / 2) + 1 'sinon on redimensionne de l'intégrale de la moitié +1
    ReDim InscritS1(1 To S1, 1 To 8): ReDim inscritS2(1 To S1 - 1, 1 To 8) 'et on redimensionne les 2 tableaux
  End If
  i = 0
  For x = 1 To UBound(TbGeneral, 1) Step 2 'une boucle incrémentée par un pas de 2
    i = i + 1
    For y = 1 To 8 'une autre boucle imbriquée pour parcourir les colonnes
      If x < UBound(TbGeneral, 1) Then 'si on atteint pas la dernière ligne
      'ci-dessous, on alimente les 2 tableaux pour les 2 dimensions (1 ligne, 8 colonnes)
        InscritS1(i, y) = TbGeneral(x, y)
        inscritS2(i, y) = TbGeneral(x + 1, y)
      Else
        InscritS1(i, y) = TbGeneral(x, y) 'sinon, on alimente que le 1er tableau
      End If
    Next y
  Next x
End With
'enfin ci-dessous, on affecte les résultats obtenus aux tableaux "serie1" et "serie2"
With Sheets("Séries")
  .Range("A7").Resize(UBound(InscritS1, 1), UBound(InscritS1, 2)) = InscritS1 'à partir de A7, on redimensionne le tableau
  .Range("J7").Resize(UBound(inscritS2, 1), UBound(inscritS2, 2)) = inscritS2 'à partir de J7, on redimensionne le tableau
  'pour "Resize", voir l'aide
End With
End Sub
Sub Tri_Tableau()
Dim Cible As Variant
 
    Do
        x = 0
 
        For i = UBound(TbGeneral, 1) To 2 Step -1 'on part de la fin du tableau
            If TbGeneral(i, 4) < TbGeneral(i - 1, 4) Then 'on compare la ligne "club" à la ligne "club" précédente
                'ci-dessous, une variable qui reprend toute les données (colonnes) de la ligne avec "|" en séparateur (pourquoi pas ?)
                Cible = TbGeneral(i, 1) & "|" & TbGeneral(i, 2) & "|" & TbGeneral(i, 3) & "|" _
                  & TbGeneral(i, 4) & "|" & TbGeneral(i, 5) & "|" & TbGeneral(i, 6) & "|" & TbGeneral(i, 7) & "|" & TbGeneral(i, 8)
                For y = 1 To 8 'on effectue le tri sur la deuxième dimension (8 colonnes)
                  TbGeneral(i, y) = TbGeneral(i - 1, y)
                  TbGeneral(i - 1, y) = Split(Cible, "|")(y - 1) 'sachant que cible commence obligatoirement à 0
                Next y
                x = 1
            End If
        Next i
    Loop While x = 1
 
End Sub

14/09/2013, 01h41
jacfld49

Bonsoir le forum, casefayere,

j'ai oublié de préciser que dans mon fichier original, il y avait des formules dans toutes les colonnes jusqu'à la ligne 105
merci d'avance
jack
14/09/2013, 09h05
casefayere

Bonjour,

et alors ?
tu ne peux pas adapter ?
et tes noms, en feuil1, c'est des formules ?

Si oui, ne tries que sur les noms.

Beaucoup d'entre vous ont tendance à ne mettre qu'une minime partie de l'exposé du problème (l'arbre qui cache la forêt) et on finit souvent avec des discussions de 50 post, au moins........

Etudies mes 3 propositions, comprends-les et je pense que tu devrais trouver ton bonheur.
14/09/2013, 11h44
jacfld49

1 pièce(s) jointe(s)

Bonjour le forum, casefayere,

oui, j'ai regarder tes 3 exemples, et comme tu expliques, je les comprends mais ce que je veux dire, c'est que toutes les données de la feuil 1 (toutes les lignes et colonnes du tableau) ont des formules car j'ai un fichier inscriptions et donc je vais chercher les inscrits dans ce fichier
je te rejoins le fichier avec les formules que j'ai fait commencer seulement en dessous des noms pour que le fichier fonctionne
merci de ton aide
jack
14/09/2013, 22h15
jacfld49

1 pièce(s) jointe(s)

Bonsoir le forum, casefayere,

Merci beaucoup Casefayere, cela fonctionne , j'aimerais si possible ajouté la même chose , c'est à dire faire des tri du tableau 2 et 3 comme pour le tableau 1 mais à placer dans les séries 1 jour 2 et séries 2 jour 2 qui sont dans la feuille série de T7 à AJ105 et dans les séries 1 jour 3 et séries 2 jour 3 qui sont dans la feuille séries de AL7 à BB105
j'espère être clair
merci
jack

Bonsoir le forum,casefayere,

J'ai donc réussi à adapter le code pour mes 2 autres tableaux
Je voudrais savoir comment modifier légèrement ce code ci-dessous pour que le 2ème tirage soit un peu différent du 1er car j'ai réussi à adapter le code à mes 2 autres tableaux mais vu que ce sont les même noms et donc même club, le tirage est le même , ce que je voudrais c'est que le 2ème tirage soit un peu différents du 1er par ex , 6 personnes du même club, 3 dans chaque séries pour le 1er tirage , idem pour le 2ème mais en essayant de changer au moins une des personnes qui change de série
merci de votre aide
jacky

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub Tri_Tableau()
Dim Cible As Variant
 
    Do
        x = 0
 
        For i = UBound(TbGeneral, 1) To 2 Step -1 'on part de la fin du tableau
            If TbGeneral(i, 4) < TbGeneral(i - 1, 4) Then 'on compare la ligne "club" à la ligne "club" précédente
                'ci-dessous, une variable qui reprend toute les données (colonnes) de la ligne avec "|" en séparateur (pourquoi pas ?)
                Cible = TbGeneral(i, 1) & "|" & TbGeneral(i, 2) & "|" & TbGeneral(i, 3) & "|" _
                  & TbGeneral(i, 4) & "|" & TbGeneral(i, 5) & "|" & TbGeneral(i, 6) & "|" & TbGeneral(i, 7) & "|" & TbGeneral(i, 8)
                For y = 1 To 8 'on effectue le tri sur la deuxième dimension (8 colonnes)
                  TbGeneral(i, y) = TbGeneral(i - 1, y)
                  TbGeneral(i - 1, y) = Split(Cible, "|")(y - 1) 'sachant que cible commence obligatoirement à 0
                Next y
                x = 1
            End If
        Next i
    Loop While x = 1
 
End Sub