bonjour
je cherche une méthode pour arranger les valeurs des colonnes E G K I M . le plage Q2; X10 par ordre (suite arithmétique de raison 9)
comme montre la figure sur document joint
Merci
petite optimisation : With Cells(lg1, cl1) et End With étaient inutiles ; je les ai supprimés, puis à la place de Cells(lg2, cl2) = .Value j'ai mis directement : Cells(lg2, cl2) = Cells(lg1, cl1) ; même utilisation qu'avant ; et mêmes résultats.
nouveau code VBA (26 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 =...
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
EDIT : j'ai optimisé mon code VBA ; voir le post #6.
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
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) :
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) :
* 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.
* les résultats (sans les en-têtes de lignes et colonnes) sont 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 !
* 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 !
Oui je te comprend les donnes sera varie suivant le nombre de salle et le nombre des profs je fais cette exemple pour préparer je veut et si possible d'ajouter comment obtenir les remplaçants?
* 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 ! )
* 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 ! )
* 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
EDIT : j'avais oublié une petite optimisation
dans mon code VBA ; voir le post #15.
* 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
petite optimisation : With Cells(lg1, cl1) et End With étaient inutiles ; je les ai supprimés, puis à la place de Cells(lg2, cl2) = .Value j'ai mis directement : Cells(lg2, cl2) = Cells(lg1, cl1) ; même utilisation qu'avant ; et mêmes résultats.
nouveau code VBA (26 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
Cells(lg2, cl2) = Cells(lg1, cl1): 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
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