Créer un tableau en serpentin
Bien le bonjour,
Je n'y connais vraiment pas grand chose en macro donc soyez patients...
Je souhaite faire une macro qui crée dans la feuille 2 un tableau en serpentin(de gauche à droite puis de droite à gauche, etc.) de haut en bas, à partir d'une colonne A dans la feuille 1. J'aimerais que le nombre de colonne et de ligne dans la tableau serpentin soit prédéfinis moi l'utilisateur (qui les choisira en fonction du nombre de données dans la colonne A). J'ai fais un jet d'essais mais je n'arrive pas à le faire fonctionner.
Si vous arrivez à trouver mes erreurs, ou si vous pensez pouvoir simplifier mon code, je suis preneur. Merci beaucoup!
bonsoir,
Public Const iColonnes = 6 'nombre de colonne pour feuil2
Sub Serpentine()
Dim aA, aOut, iDirection, i, iL, iC
aA = Sheets("feuil1").Range("A1:A100").Value 'lire les cellules vers une matrice
ReDim aOut(1 To 1 + UBound(aA) \ iColonnes, 1 To iColonnes) 'dimensioner matrice résultat
iDirection = 1: iL = 1: iC = 1 'initialiser valeurs
For i = 1 To UBound(aA) 'boucle les données
aOut(iL, iC) = aA(i, 1) 'coller dans la matrice
iC = iC + iDirection 'colonne suivante
If Not (1 <= iC And iC <= iColonnes) Then 'si hors range
iC = Application.Max(1, Application.Min(iC, iColonnes)) 'les limits de iC
iDirection = -iDirection 'inverser direction
iL = iL + 1 'ligne suivante
End If
Next
Sheets("Feuil2").Range("A1").Resize(iL, iColonnes).Value = aOut
End SubWow merci beaucoup, c'est exactement ce qu'il me fallait ! Serait il possible de faire le même serpentin de gauche à droite, mais allant de bas en haut? Comment faire commencer la macro au bon endroit sachant que le nombre de données dans la colonne A est variable?
Cordialement,
Aloïs
Ah, par contre je viens de remarquer que je ne peux pas choisir combien de colonnes doit faire le serpentin. C'est avec la valeur de iColonnes que je dois jouer?
Merci
re,
il faut arrondir le nombre de lignes vers l'integer suivant avec WorksheetFunction.Ceiling_Math(UBound(aA) / iColonnes, 1)
Sub Serpentine_Vert()
Dim aA, aOut, iDirection, i, iL, iC
aA = Sheets("feuil1").Range("A1:A102").Value 'lire les cellules vers une matrice
ReDim aOut(1 To WorksheetFunction.Ceiling_Math(UBound(aA) / iColonnes, 1), 1 To iColonnes) 'diminsioner matrice résultat
iDirection = 1: iL = 1: iC = 1 'initialiser valeurs
For i = 1 To UBound(aA) 'boucle les données
aOut(iL, iC) = aA(i, 1) 'coller dans la matrice
iL = iL + iDirection 'ligne suivante
If Not (1 <= iL And iL <= UBound(aOut)) Then 'si hors range
iL = Application.Max(1, Application.Min(iL, UBound(aOut))) 'les limits de iL
iDirection = -iDirection 'inverser direction
iC = iC + 1 'ligne suivante
End If
Next
Sheets("Feuil2").Range("A1").Resize(UBound(aOut), UBound(aOut, 2)).Value = aOut 'la matrice = toutes les lignes et les colonnes utilisées
End SubMerci de ta réponse, mais ma seconde requête n'était pas assez claire : je souhaite avoir un serpentin qui commence "en bas à gauche" du plan et qui remonte comme dans le fichier joint
Cordialement,
Aloïs
re, une variante = Serpentine_Hor2
J'essaie de faire le serpentin cette fois ci commençant en haut à droite et finissant en bas à gauche
(oui, il me faut beaucoup de serpentins).
Avec le code suivant, qui fait bien démarrer à la cellule voulu, la suite ne se continue pas... Qu'est ce qui ne va pas?
Sub Serpentin_HB_inv()
Dim iColonnes As Integer 'nombre de colonne pour feuil2
iColonnes = Sheets("feuil1").Range("C2").Value
Dim aA, aOut, iDirection, i, iL, iC
aA = Sheets("feuil1").Range("A:A").Value 'lire les cellules vers une matrice
ReDim aOut(1 To 1 + UBound(aA) / iColonnes, 1 To iColonnes) 'diminsioner matrice résultat
iDirection = 1: iL = 1: iC = iColonnes 'initialiser valeurs
For i = 1 To UBound(aA) 'boucle les données
aOut(iL, iC) = aA(i, 1) 'coller dans la matrice
iC = iColonnes - iDirection 'colonne suivante
If Not (1 <= iC And iC <= iColonnes) Then 'si hors range
iC = Application.Max(1, Application.Min(iC, iColonnes)) 'les limits de iC
iDirection = -iDirection 'inverser direction
iL = iL + 1 'ligne suivante
End If
Next
Sheets("Feuil2").Range("B2").Resize(iL, iColonnes).Value = aOut 'le positionnement de la matrice
End SubMerci!
re,
la plage n'est pas une colonne complète (=+1.048.000 cellules), mais ici A1:A100 et avec "Currentregion.columns(1)" ou Range("A1:A" & range("A" & rows.count).end(xlup).row) ou ..., on sélectionne cette plage.
on commence à droite de la première ligne et on va de droite à gauche = numéro de colonnes descendant, donc iDirection = -1 pour faire cela.
La prochaine cellule sera alors dans la colonne "iC=iC + iDirection" et en fonction de la valeur de iDirection ascendent(+1) ou descendant(-1).
iC = Application.Max(1, Application.Min(iC, iColonnes))
Si un moment iC<1 avec la construction ici dessus, la partie application.max(1, ...) décide que iC=1, même chose avec iC>iColonnes, la partie Application.min(iC ,iColonnes) décide que iC=iColonnes
La ligne Debug.Print "numéro=" & i & " ligne=" & iL & " colonne=" & iC & " " & "Direction=" & iDirection 'Avec CTRL+G = Window "Direct" = quand on veut tester la macro on ouvre la fenêtre de VBA et on fait CTRL+G pour avoir la fenêtre "Direct". Si maintenant on utilise F8 pour executer la macro pas-à-pas, quand on execute cette ligne, on voit dans la fenêtre directe les valeurs actuelles. Plus tard, on met cette ligne en commentaire en ajoutant un ' en face.
petit modification : ReDim aOut(1 To WorksheetFunction.RoundUp(UBound(aA) / iColonnes, 0), 1 To iColonnes) 'diminsioner matrice résultat, ce Roundup est plus élégant pour arrondir.
Pour une autre serpentine, qui utilise les colonnes au lieu des lignes, iDirection est +1 pour sélectionner la ligne suivante et -1 pour la ligne précédente.
Compris ???