Comment partager une colonne

Bonjour

Tout est dit dans le titre

Explications complètes dans le fichier ci-joint

Merci pour votre aide

Salut Joco,

non, tout n'est pas dit...
Le total d'items de ta liste de nombres sera-t-il toujours un multiple de 8 ?

A+

Bonjour curulis 57

Merci pour ton aide

Non le total d'items de la liste des nombres ne sera pas toujours multiple de 8

Crdlt

Bonjour à tous,

Supposons que le nombre d'items soit de 25. Compte tenu de la contrainte du nombre de colonnes (8), ce vingt-cinquième élément serait placé en quatrième ligne ?

Cette hypothèse ne respecte pas l'ordre initial. Alors ?

Salut Joco,
Salut JFL,

tordu mais...
Un double-clic démarre la macro. Question localisation des données, ne fonctionnera qu'avec ton exemple, bien sûr.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim iRow%, iCol%, iNb%, iMod%, iNum%
Cancel = True
'
iRow = Range("A" & Rows.Count).End(xlUp).Row
iNb = Fix((iRow - 1) / 8)
iMod = (iRow - 1) Mod 8
'
[D2:S18].ClearContents
iCol = 2
For x = 2 To iRow
    iRow = 1
    iCol = iCol + 2
    iNum = iNum + 1
    For y = x To x + (iNb - 1) + IIf(iNum <= iMod, 1, 0)
        iRow = iRow + 1
        Cells(iRow, iCol) = Range("A" & y).Value
    Next
    x = y - 1
Next
'
End Sub

A+

Bonjour,
Une autre proposition.
Cdlt.

Public Sub RowsToColumns()
Dim rng As Range
Dim lastRow As Long, rw As Long
Dim lRow As Long: lRow = 2
Dim lCol As Long: lCol = 5
Dim n As Double

    With ActiveSheet
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        Set rng = .Cells(2, 1).Resize(lastRow - 1)
        n = WorksheetFunction.RoundUp(rng.Rows.Count / 8, 0)
        For rw = 2 To rng.Rows.Count Step n
            .Cells(lRow, lCol).Resize(n).Value = .Cells(rw, 1).Resize(n).Value
            lCol = lCol + 1
        Next rw
    End With

End Sub

Bonjour à tous

Merci pour vos réponses

@Jean-Eric je te remet le fichier ,quand on ajoute des nombres dans la colonne A

le partage ne se fait pas sur 8 colonnes.

De plus est-il possible que le partage dans les colonnes soit randomisé sans doublon.

Bonjour de nouveau,

@Joco7915 : Mon précédent message ne semble pas vous interpeller.......

Comment voulez-vous opérer avec 25 items sur 8 colonnes ?

Bonjour,

25= (4 * 8) -7

ou 25= (4 * 6)+1

4 lignes. 6 colonnes +le dernier chiffre (25) sur sur la 7ème colonne, la 8ème étant vide

Bonjour de nouveau,

scraper a écrit :

4 lignes. 6 colonnes +le dernier chiffre (25) sur sur la 7ème colonne, la 8ème étant vide

C'est très précisément le souci !

La contrainte des 8 colonnes n'est pas respectée.

Il me semble que la contrainte du nombre de colonnes est incompatible avec l'ordre des chiffres en colonne.

Bonjour JFL

Avec mes excuses car j'ai zappé ton message.

Le nombre d'items est variable mais le nombre de colonnes est impérativement de 8.

Il faudrait que les nombres qui sont en colonne A soient randomisés et distribués dans les 8 colonnes

Exemple si 37 nombres colonne A 4 lignes de 8 dans les 8 colonnes + une ligne de 5 sur les 5 premières colonnes

Je ne sais pas si je suis assez clair,en tout cas j'essaie de l’être

Merci pour ton aide

Qu'appelles-tu, randomisés, Joco ?

Re,
Une mise à jour !
Pour un nombre lignes non multiple de 8 !...
Cdlt.

Public Sub RowsToColumns()
Dim rng As Range
Dim lastRow As Long, rw As Long
Dim lCol As Long: lCol = 5
Dim a As Double

    With ActiveSheet
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        Set rng = .Cells(2, 1).Resize(lastRow - 1)
        a = WorksheetFunction.RoundUp(rng.Rows.Count / 8, 0)
        For rw = 2 To rng.Rows.Count Step a
            If lCol <= 11 Then
                .Cells(2, lCol).Resize(a).Value = .Cells(rw, 1).Resize(a).Value
                lCol = lCol + 1
            Else
                .Cells(2, lCol).Resize(a).Value = .Cells(rw, 1).Resize(a).Value
            End If
        Next rw
    End With

End Sub

@Curulis 57 Randomiser = Mélanger de manière aléatoire

@Jean-Eric il me faut impérativement mes 8 colonnes comme dans le fichier si joint et pareil de façon aléatoire

Salut Joco,
Salut l'équipe,

un double-clic démarre la macro à volonté.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim tTab, iRow%, iCol%, iNb%, iMod%, iNum%
Cancel = True
'
iRow = Range("A" & Rows.Count).End(xlUp).Row
iNb = Fix((iRow - 1) / 8)
iMod = (iRow - 1) Mod 8
'
tTab = Range("A2:A" & iRow).Value
[D2:S18].ClearContents
iCol = 2
For x = 2 To iRow
    iTRow = 1
    iCol = iCol + 2
    iNum = iNum + 1
    For y = x To x + (iNb - 1) + IIf(iNum <= iMod, 1, 0)
        iTRow = iTRow + 1
        Do
            iRnd = Int((iRow - 1) * Rnd + 1)
        Loop Until CInt(tTab(iRnd, 1)) > 0
        Cells(iTRow, iCol) = tTab(iRnd, 1)
        tTab(iRnd, 1) = 0
    Next
    x = y - 1
Next
'
End Sub

A+

Re bonjour

Je te joins le fichier comme il devrait être finalement

1°j'ai un beug quand j'efface les noms en colonne B et que je remet des noms en suite

sur cette ligne de code

Loop Until CInt(tTab(iRnd, 1)) > 0

2°J'ai du neutraliser cette ligne car elle efface mes formules dans les colonnes E.G.I.K.L.N.Q.S

[D2:S18].ClearContents

3° est-il possible de déclencher le code sans double cliquer mais plutot en tenant

compte de la valeur de la cellule A1  (valeur variable)

Waow,

- des noms ;
- des formules ;
- une valeur en [A1]

Plein d'infos qu'on avait, tiens, qui plus est, dans un fichier fantôme !

Tu peux être sérieux, stp, et nous fournir des explications enfin complètes et claires ?

A+

Bonjour curulis

Pas la peine de m'agresser,j'ai tout simplement oublié de joindre le fichier.

Le sujet est résolu

Crdlt