XL 2016 Arrangement des valeurs sur plage

soan à dit:

Bonjour Seddiki,

fais Ctrl e ➯ travail effectué !

---

code VBA (17 lignes) :

VB:

Option Explicit

Sub Essai()
  Dim cl1 As Byte, lg1&, cl2 As Byte, lg2 As Byte, vx%
  cl1 = 5: lg1 = 2: cl2 = 17: lg2 = 2: Application.ScreenUpdating = 0
  Do
    With Cells(lg1, cl1)
      If IsEmpty(.Value) Then
        lg1 = 2: cl1 = cl1 + 2: If cl1 = 15 Then Exit Sub
      End If
      vx = .Value: lg1 = lg1 + 1: Cells(lg2, cl2) = vx: lg2 = lg2 + 1
      If lg2 = 11 Then lg2 = 2: cl2 = cl2 + 1
      If cl2 = 25 Then Exit Sub
    End With
  Loop
End Sub

soan

Cliquez pour agrandir...

Marcel32 à dit:

Bonjour,

Une autre proposition :

Code:

=DECALER($E$2;9*(COLONNE(Q1)-COLONNE($Q$1))+(LIGNE(Q1)-LIGNE($Q$1));0)

Cliquez pour agrandir...

soan à dit:

@Seddiki (salut Marcel)

j'avais utilisé la variable vx, mais en fait, c'était inutile ; j'ai donc optimisé le code vba en supprimant cette variable vx ; le code vba fait toujours 17 lignes.​

VB:

Option Explicit

Sub Essai()
  Dim cl1 As Byte, lg1&, cl2 As Byte, lg2 As Byte
  cl1 = 5: lg1 = 2: cl2 = 17: lg2 = 2: Application.ScreenUpdating = 0
  Do
    With Cells(lg1, cl1)
      If IsEmpty(.Value) Then
        lg1 = 2: cl1 = cl1 + 2: If cl1 = 15 Then Exit Sub
      End If
      lg1 = lg1 + 1: Cells(lg2, cl2) = .Value: lg2 = lg2 + 1
      If lg2 = 11 Then lg2 = 2: cl2 = cl2 + 1
      If cl2 = 25 Then Exit Sub
    End With
  Loop
End Sub

résultat de ce 2ème code vba (identique à celui du 1er code vba) :

Regarde la pièce jointe 1140710

soan

Cliquez pour agrandir...

soan à dit:

@Seddiki

* les rangs sont dans cette plage : "E1:E76, G1:G76, I1:I76, K1:K76, M1:M76" ; il y a 5 colonnes, et comme en ligne 1 c'est pour les en-têtes, les nombres sont sur 75 lignes (pas 76) ; il y a donc en tout 5 × 75 = 375 nombres.

* l'emplacement des résultats (sans les en-têtes de lignes et colonnes) est dans cette plage : Q2:X10 ; il y a donc en tout une place de 9 lignes × 8 colonnes = 72 nombres.

c'est donc évident qu'on ne peut pas afficher tous les rangs dans le tableau des résultats : même la 1ère colonne de rangs E n'y tient pas entièrement ! en effet, on ne peut pas afficher 73 à 75 de E74:E76 ; encore moins les rangs des colonnes G, I, K, M !

la solution serait donc d'agrandir le tableau des résultats ! ​

soan

Cliquez pour agrandir...

Seddiki_adz à dit:

si possible d'ajouter comment obtenir les remplaçants ?

Cliquez pour agrandir...

soan à dit:

@Seddiki



* avec le même fichier "Classeur11122" de mon post #6 ou avec un autre fichier Excel ?
* quelle est la plage des rangs des remplaçants ?
* dans quelle plage mettre les résultats ? ce sera aussi en Q2:X10 ? ou ailleurs ?

ce sera peut-être mieux que tu fournisses un autre fichier exemple.

---

edit : comme tu as écrit : « je fais cet exemple pour préparer », je crois que tu vas bientôt fournir un autre fichier Excel. (où y'aura sûrement c'qu'il faut pour les remplaçants ! )​

soan

Cliquez pour agrandir...

soan à dit:

@Seddiki

sur "Feuil1" :

* le tableau des profs est vide : aucune donnée en Q5:AH13
* le tableau des remplaçants est vide : aucune donnée en Q29:W37
* fais Ctrl e ➯ ça remplit entièrement les 2 tableaux

remarque : comme je n'ai pas vu de rangs pour les remplaçants, j'ai supposé que tu utilises les mêmes données que celles des rangs des profs : données en "E5:E79, G5:G79, I5:I79, K5:K79, M5:M79" ; si les rangs des remplaçants sont à un autre endroit, tu aurais dû l'indiquer !

(sauf erreur de ma part, j'ai rien vu à faire sur "Feuil2" !)​

---

code VBA (28 lignes) :

VB:

Option Explicit

Private Sub Job(k As Byte)
  Dim cl1 As Byte, lg1&, dlA&
  Dim cl2 As Byte, lg2 As Byte, dlB As Byte
  Dim dcB As Byte, lgA As Byte, lgB As Byte
  If k = 1 Then 'pour les professeurs
    cl1 = 5: lg1 = 5: dlA = 79: cl2 = 17: lg2 = 5: dlB = 13: dcB = 34
  Else 'pour les remplaçants
    cl1 = 5: lg1 = 5: dlA = 79: cl2 = 17: lg2 = 29: dlB = 37: dcB = 23
  End If
  lgA = lg1: lgB = lg2: dlA = dlA + 1: dlB = dlB + 1: dcB = dcB + 1
  Do
    With Cells(lg1, cl1)
      Cells(lg2, cl2) = .Value: lg1 = lg1 + 1: lg2 = lg2 + 1
      If lg1 = dlA Then lg1 = lgA: cl1 = cl1 + 2: If cl1 = 15 Then Exit Sub
      If lg2 = dlB Then lg2 = lgB: cl2 = cl2 + 1: If cl2 = dcB Then Exit Sub
    End With
  Loop
End Sub

Sub Essai()
  If ActiveSheet.Name <> "Feuil1" Then Exit Sub
  Application.ScreenUpdating = 0
  Job 1 'pour les professeurs
  Job 2 'pour les remplaçants
End Sub

soan

Cliquez pour agrandir...