XL 2016 Organiser des nom sur une plage

Seddiki_adz

XLDnaute Impliqué
Bonjour
J'ai deux feuils
depuis la feuil1 vers la feuil 2 je souhaite organiser les noms numéroter de 1 a 25 dans colonne numéro C et les noms numéroter de 26 a 50 dans colonne numéro D et les noms numéroter de 51 a 75 dans colonne numéro E
si possible
Merci
 

Pièces jointes

  • organisation.xlsx
    9.4 KB · Affichages: 11
Solution
Bonjour à toutes & à tous, bonjour @Seddiki_adz
Voilà donc une version qui trie horizontalement chaque ligne de ton tableau.
Pour le fun, j'ai procédé par calcul du rang de chaque élément dans sa ligne. :
VB:
Sub Tri_Hrztl()
'Tri horizontal d'une plage de la feuil1 vers une plage de la feuil2
     Dim RgS As Range, RgC As Range, Adr$, Tb, NbL As Integer, NbC As Integer, i As Integer, j As Integer, tbl()
    
     Set RgS = Feuil1.[B2:D26]                    'Plage source
     Set RgC = Feuil2.[C2:E26]                    'Plage Cible
     Tb = RgS.Value                                'Tableau des valeurs à trier
     Adr = "'" & Feuil1.Name & "'!" & RgS.Address  'Adresse de la plage à trier
    
     NbL = UBound(Tb, 1): NbC =...

AtTheOne

XLDnaute Impliqué
Supporter XLD
bonjour à toutes & à tous, bonjour @Seddiki_adz
En activant la feuil2, la plage C2:E76 se remplit avec les noms triés dans l'ordre croissant :
Evénement Activate de Feuil2 :
VB:
Private Sub Worksheet_Activate()
     mdl_AtTheOne.DansOrdre
End Sub

Macro de remplissage :
VB:
Sub DansOrdre()
     Tb = Feuil1.[B2:D26]
    
     Nbl = UBound(Tb, 1): NbC = UBound(Tb, 2)
     ReDim Tb1(1 To Nbl * NbC)
     For i = 1 To Nbl: For j = 1 To NbC
          Tb1(j + (i - 1) * NbC) = Tb(i, j)
     Next j: Next i
     Call tri(Tb1, 1, Nbl * NbC)
     For j = 1 To NbC: For i = 1 To Nbl
          Tb(i, j) = Tb1(i + (j - 1) * Nbl)
     Next i: Next j
    
     Feuil2.[C2:E26].Value = Tb
End Sub

Macro Tri de J. BOISGONTIER :
Enrichi (BBcode):
Sub tri(a, gauc, droi) ' Quick sort Jacques BOISGONTIER
  ref = a((gauc + droi) \ 2)
  g = gauc: d = droi
  Do
    Do While a(g) < ref: g = g + 1: Loop
    Do While ref < a(d): d = d - 1: Loop
    If g <= d Then
       temp = a(g): a(g) = a(d): a(d) = temp
       g = g + 1: d = d - 1
    End If
  Loop While g <= d
  If g < droi Then Call tri(a, g, droi)
  If gauc < d Then Call tri(a, gauc, d)
End Sub

Voir PJ
A bientôt
 

Pièces jointes

  • organisation1.xlsm
    18.4 KB · Affichages: 3

AtTheOne

XLDnaute Impliqué
Supporter XLD
Re,
Je ne comprends plus ton besoin :
Si dans ta feuil1 1 les noms sont déjà organisés selon les salles que veux-tu faire dans la feuil1 ?
En S1 on a les surveillants en B2, C2, D2,
EN S2 on a les surveillants en B3, C3, D3
Etc
Que faire en feuil1 ???
Une liste alphabétique sur 3 colonnes avec nom et salle associée
Par exemple Nom1 - S15 , Nom2 - S8 ...

A bientôt
 

Seddiki_adz

XLDnaute Impliqué
Re,
Je ne comprends plus ton besoin :
Si dans ta feuil1 1 les noms sont déjà organisés selon les salles que veux-tu faire dans la feuil1 ?
En S1 on a les surveillants en B2, C2, D2,
EN S2 on a les surveillants en B3, C3, D3
Etc
Que faire en feuil1 ???
Une liste alphabétique sur 3 colonnes avec nom et salle associée
Par exemple Nom1 - S15 , Nom2 - S8 ...

A bientôt
trier horizontal
 
Dernière édition:

AtTheOne

XLDnaute Impliqué
Supporter XLD
Bonjour à toutes & à tous, bonjour @Seddiki_adz
Voilà donc une version qui trie horizontalement chaque ligne de ton tableau.
Pour le fun, j'ai procédé par calcul du rang de chaque élément dans sa ligne. :
VB:
Sub Tri_Hrztl()
'Tri horizontal d'une plage de la feuil1 vers une plage de la feuil2
     Dim RgS As Range, RgC As Range, Adr$, Tb, NbL As Integer, NbC As Integer, i As Integer, j As Integer, tbl()
    
     Set RgS = Feuil1.[B2:D26]                    'Plage source
     Set RgC = Feuil2.[C2:E26]                    'Plage Cible
     Tb = RgS.Value                                'Tableau des valeurs à trier
     Adr = "'" & Feuil1.Name & "'!" & RgS.Address  'Adresse de la plage à trier
    
     NbL = UBound(Tb, 1): NbC = UBound(Tb, 2)     'Limites du tableau des valeurs
     For i = 1 To NbL
          ReDim tbl(1 To NbC)                     'Tableau temporaire (1 ligne)
          For j = 1 To NbC
               'rang de l'élément dans la ligne du tableau des valeurs - nb éléments déjà présents dans le tableau temporaire
               Place = Evaluate(NbC & "-COUNTIF(Index(" & Adr & "," & i & ",0),"">""&""" & Tb(i, j) & """)") - _
                       Evaluate("SUM(N({""" & Join(tbl, """,""") & """}=""" & Tb(i, j) & """))")
               tbl(Place) = Tb(i, j)
          Next j
          For j = 1 To NbC
               'Remplacement dans le tableau des valeurs
               If Not IsEmpty(tbl(j)) Then Tb(i, j) = tbl(j)
          Next
     Next i
     RgC.Value = Tb
End Sub

Voir la PJ
A bientôt
 

Pièces jointes

  • organisation2.xlsm
    18.4 KB · Affichages: 3

Seddiki_adz

XLDnaute Impliqué
Bonjour à toutes & à tous, bonjour @Seddiki_adz
Voilà donc une version qui trie horizontalement chaque ligne de ton tableau.
Pour le fun, j'ai procédé par calcul du rang de chaque élément dans sa ligne. :
VB:
Sub Tri_Hrztl()
'Tri horizontal d'une plage de la feuil1 vers une plage de la feuil2
     Dim RgS As Range, RgC As Range, Adr$, Tb, NbL As Integer, NbC As Integer, i As Integer, j As Integer, tbl()
   
     Set RgS = Feuil1.[B2:D26]                    'Plage source
     Set RgC = Feuil2.[C2:E26]                    'Plage Cible
     Tb = RgS.Value                                'Tableau des valeurs à trier
     Adr = "'" & Feuil1.Name & "'!" & RgS.Address  'Adresse de la plage à trier
   
     NbL = UBound(Tb, 1): NbC = UBound(Tb, 2)     'Limites du tableau des valeurs
     For i = 1 To NbL
          ReDim tbl(1 To NbC)                     'Tableau temporaire (1 ligne)
          For j = 1 To NbC
               'rang de l'élément dans la ligne du tableau des valeurs - nb éléments déjà présents dans le tableau temporaire
               Place = Evaluate(NbC & "-COUNTIF(Index(" & Adr & "," & i & ",0),"">""&""" & Tb(i, j) & """)") - _
                       Evaluate("SUM(N({""" & Join(tbl, """,""") & """}=""" & Tb(i, j) & """))")
               tbl(Place) = Tb(i, j)
          Next j
          For j = 1 To NbC
               'Remplacement dans le tableau des valeurs
               If Not IsEmpty(tbl(j)) Then Tb(i, j) = tbl(j)
          Next
     Next i
     RgC.Value = Tb
End Sub

Voir la PJ
A bientôt
Excellent
Merci
 

Discussions similaires

Statistiques des forums

Discussions
312 229
Messages
2 086 423
Membres
103 206
dernier inscrit
diambote