Discussion :

[ericlb56]

Bonjour, j'ai un soucis pour réaliser une macro comme énoncé dans le titre, voici l'énnoncé du problème:
Dans mon tableau, j'ai un nom de rue en A, un chiffre en B, en N° de rue en C et un Nom en D + d'autres colonnes sans intérêt pour cette macro.
Je voudrais extraire dans une autre feuille le contenu transposé en ligne des colonnes A, B, C et D en additionnant à chaque ligne le chiffre de la colonne B jusqu'à obtenir un total maximum de 14.
Une fois les colonnes transposés en ligne et le chiffre 14 atteint il faudrait que l'opération se poursuive en passant 3 lignes plus bas et ainsi de suite jusqu'à la fin de mon tableau.
Merci par avance de vos conseils.

Ci joint un tableau d'exemple rempli de données hasardeuse pour mieux exposer mon problème.

[tony76]

bonjour,

A tu essayer de le faire avec l'enregistreur de macro et voir avec la fonction TRANSPOSE()
voir ce que sa donne ?

[ericlb56]

bonjour tony76,
oui, j'ai effectivement essayé avec l'enregistreur de macro, mais je ne parviens pas à obtenir le résultat essentiel à mon souhait qui est de revenir 3 lignes plus bas une fois le chiffre atteint.
c'est pour cette raison que je n'ai joint aucun bout de code, car la solution est je pense, à batir à partir de là, mais je ne trouve aucunes pistes.

merci de votre intervention

[tony76]

Voici un début reste a faire une boucle pour que cela continu jusqu'a 14 etc....

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
 
Sub TRANSPOSITION()
    Sheets(1).Range("A2:D2").Copy
    Sheets(2).Range("B1").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
End Sub

[Qwazerty]

Salut

En règle générale on évite autant que possible d'utiliser Select, on préférera pointer la cellule dans une variable ou dans une structure With.

Tu peux réaliser ce que tu souhaites en faisant quelques-choses comme ça. Il faudra ajouter une feuille à ton document. Le nom Feuil3 correspond au codename de la feuille

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
Option Explicit
 
Sub TransposeBase()
Dim CellInA As Range
Dim Destination As Range
Dim OffsetCol As Variant
 
 
    'On pointe la cellule de destination
    Set Destination = Feuil3.Range("A1")
 
    'On commence par boucler sur le contenu de la colonne A
    For Each CellInA In Feuil1.Range("A2", Feuil1.Cells(Feuil1.Rows.Count, "A").End(xlUp))
 
        'On Boucle ensuite sur les 4 cellules de la ligne
        'On utilise Offset pour se décaler de la cellule de départ (ici CellInA)
        'On note dans un array les offset dans l'ordre ou doivent apparaitre les données
        '2: on se décale de 2 cellules à droite en partant de A donc C (N° de rue)
        '3: on se décale de 3 cellules à droite en partant de A donc D (Nom)
        '0: on se décale de 0 cellule à droite en partant de A donc A (Rue)
        '...
        For Each OffsetCol In Array(2, 3, 0, 1)
            'On place la valeur dans destination
            Destination.Value = CellInA.Offset(, CInt(OffsetCol)).Value
            'On pointe la cellule de destination suivante
            Set Destination = Destination.Offset(1)
        Next
 
        'On saute deux cellules de destination, on pointe la 3ème
        Set Destination = Destination.Offset(3)
 
    Next
 
End Sub

++
Qwaz

[ericlb56]

Merci qwaz pour votre réponse et le cours qui va avec.
j'ai testé la macro en l'adaptant à mon fichier mais cela ne correspond qu'en partie à ce que je cherche. En effet, je me suis mal expliqué (et/ou mon fichier exemple n'etait pas assez explicite, je l'ai modifie).
Ce que je voudrais, pour la 1ère ligne (j'entend par ligneestination.Offset(1)) c'est bon, c'est que la 2ème ligne de votre solution soit placée en colonne B, puis la 3ème ligne en colonne C.... jusqu'à obtenir une somme (de la ligne 4 de la feuille résultat) < à 15 mais le plus proche possible de ce chiffre, puis à cette condition seulement, passer à la ligne suivante (Destination.Offset(3)).

Je cherche sur le forum quelques indices, mais pour l'instant…… j'y arrive pas!
Encore merci.
éric

[Qwazerty]

Salut

Le fichier ne contenait pas cette structure en effet mais je suis aussi passé à coté du texte de votre 1er message qui faisait état de cette contrainte de 14. Bref, voila une modification possible.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
Option Explicit
 
Sub TransposeBase()
Dim CellInA As Range
Dim Destination As Range, iRow As Long, iCol As Integer
Dim OffsetCol As Variant
Dim TotalChiffre As Byte
 
    'On pointe la cellule de destination
    Set Destination = Feuil3.Range("A1")
    'On place les données à partir de la 1ère ligne et de la 1ère colonne
    iRow = 1
    iCol = 1
 
    'On commence par boucler sur le contenu de la colonne A
    For Each CellInA In Feuil1.Range("A2", Feuil1.Cells(Feuil1.Rows.Count, "A").End(xlUp))
 
        'On cumule les valeurs de Chiffre
        TotalChiffre = TotalChiffre + CellInA.Offset(, 1).Value
 
        'On regarde si on dépasse 14
        If TotalChiffre > 14 Then
            'On se décale de 5 lignes
            iRow = iRow + 5
            'On retourne à la 1ère colonne
            iCol = 1
            'On recommence à compter
            TotalChiffre = CellInA.Offset(, 1).Value
        End If
 
        'On copie les données
        With Feuil3
            .Cells(iRow, iCol).Value = CellInA.Offset(, 2).Value
            .Cells(iRow + 1, iCol).Value = CellInA.Offset(, 3).Value
            .Cells(iRow + 2, iCol).Value = CellInA.Offset(, 0).Value
            .Cells(iRow + 3, iCol).Value = CellInA.Offset(, 1).Value
        End With
 
       'On passe à la colonne suivante
       iCol = iCol + 1
 
    Next
 
End Sub

++
Qwaz