Discussion :

[bniox]

Bonsoir, en désespoir de cause je viens vous demander votre aide:

j'ai deux colonne A et B.
dans ma colonne A j'ai des ID
dans la B j'ai des infos: info1, info2... infoX
par ID j'ai entre 3 et 8 infos
je voudrais avoir chaque id + info sur une seul et même ligne avec chaque info dans une colonne.

Je ne suis vraiment pas un expert en VBA et le seul truc que j'ai réussi à faire c'est à planter mon ordi.
Je laisse un screen shot, qui vaut toutes les explications du monde, à l'âme charitable qui aura pitié de moi.



très bonne journée a tous

[unparia]

Bonjour

Je ne suis vraiment pas un expert en VBA

Mais tu n'as pas ouvert cette discussion dans la section VBA mais ici :

Index du forum -Logiciels -Microsoft Office - Excel

Je vais donc, ici, me contenter de ceci : Intéresse-toi entre autres à la méthode WorksheetFunction.Transpose

[riaolle]

Bonjour,
En plus de ce que te dit unparia, une piste de réflexion :
Pour la colonne A : dans Excel, pour aller d'une ligne non vide à une autre tu utilises la combinaison de touches Ctrl+flèche du bas. Tu peux t'inspirer de cela et utiliser l'enregistreur de macro.

le seul truc que j'ai réussi à faire c'est à planter mon ordi.

Pour t'aider, il serait bien que tu nous montres le code que tu as pour l'instant.
A bientôt avec plus de précisions

[Pierre Fauconnier]

[...]Intéresse-toi entre autres à la méthode WorksheetFunction.Transpose

Transpose n'est d'aucune utilité ici... Voici le résultat d'un transpose


Voici un code qui pourrait convenir, parmi beaucoup d'autres

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
Sub Transpose()
  Dim StartCell As Range
  Dim TargetCell As Range
  Dim Counter As Long
 
  Set StartCell = Range("B1")
  Set TargetCell = Range("D1")
  Do ' On démarre la boucle au moins une fois
    Counter = 2
    TargetCell.Value = StartCell(1, 0).Value ' Attribution de la valeur de la colonne 1
    Do ' On copie la valeur actuelle de la colonne 2 au moins une fois
      TargetCell(1, Counter).Value = StartCell.Value
      Set StartCell = StartCell(2) ' On descend d'une ligne en colonne 2
      Counter = Counter + 1
    Loop While IsEmpty(StartCell(1, 0)) And Not IsEmpty(StartCell) ' On boucle tant que colonne 1 est vide et pas colonne 2
    Set TargetCell = TargetCell(2)
    Counter = 2
  Loop While Not IsEmpty(StartCell) ' On boucle tant qu'il y a une valeur en colonne 2
End Sub

[pijaku]

Bonjour,

Transpose n'est d'aucune utilité ici... Voici le résultat d'un transpose

Oups!
Pas tout à fait.
Voici un code (vite bâclé) qui obtient le résultat avec Application.Transpose, et une seule et unique boucle.

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
Option Explicit
 
Sub test()
    Dim Rng As Range, RngInit As Range, Plage As Range, RngRestit As Range
    Dim TB
 
    Set RngInit = Range("A1")
    Set RngRestit = Range("D1")
    Do
        Set Rng = RngInit.End(xlDown)
        If Rng.Row = Rows.Count Then Exit Do
        Set Plage = Range(RngInit.Address & ":B" & Rng.Row - 1)
        RngRestit.Value = Plage.Cells(1, 1).Value
        TB = Plage.Columns(2)
        RngRestit.Offset(0, 1).Resize(, Plage.Rows.Count) = Application.Transpose(TB)
        Set RngInit = Rng
        Set RngRestit = RngRestit.Offset(1, 0)
    Loop
    Set Rng = RngInit.Offset(0, 1).End(xlDown)
    Set Plage = Range(RngInit.Address & ":B" & Rng.Row - 1)
    RngRestit.Value = Plage.Cells(1, 1).Value
    TB = Plage.Columns(2)
    RngRestit.Offset(0, 1).Resize(, Plage.Rows.Count) = Application.Transpose(TB)
 
    Set RngInit = Nothing: Set RngRestit = Nothing
    Set Plage = Nothing: Set Rng = Nothing
End Sub

[Invité]

on ne gère pas 60000 ligne comme ça! les données dans ce cas sont forcément enregistrées!

là je fais du Sql! c'est ma tasse de thé alors pourquoi m'en priver!

[pijaku]

Bonjour,

Merci à tous.
J'essaie de revenir plus tard sur ce sujet...

[Invité]

bonjour,
Edité!

Code Module standard :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Dim Dico As Object, RSub test()
Dim R As Range, L As Long, Cel As String, cell As Range
Set Dico = CreateObject("Scripting.Dictionary")
Set R = Sheets("Feuil1").UsedRange
For L = 1 To R.Rows.Count
    If Trim("" & R(L, 1)) <> "" Then Cel = R(L, 1).Value: Set cell = R(L, 1)
    If Not Dico.exists(Cel) Then Dico.Add Cel, New Classe1
    Dico(Cel).Add Cel, cell, R(L, 2).Address
Next
K = Dico.Keys
For L = 0 To Dico.Count - 1
   Dico(K(L)).past Sheets("Feuil1")
Next
End Sub

Code Module de classe :

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
Private Dico As Object, cell_ As Range
 
Private Sub Class_Initialize()
Set Dico = CreateObject("Scripting.Dictionary")
End Sub
Public Sub Add(K As String, cell As Range, Cel As String)
Set cell_ = cell
 Dico(K & "_" & Cel) = Cel
End Sub
 
 
Public Sub past(Sh As Worksheet)
Dim C As Long
K = Dico.Keys
With Sh
derl = .Cells(.Rows.Count, "E").End(xlUp).Row + 1
If Trim("" & .Cells(derl - 1, "E")) = "" Then derl = derl - 1
cell_.Copy .Cells(derl, "E").Offset(0, C)
For L = 0 To Dico.Count - 1
 C = C + 1
 .Range(Dico(K(L))).Copy .Cells(derl, "E").Offset(0, C)
 
 
Next
End With
 
 
End Sub

[pijaku]

Salut Robert,

Tu as sorti l'artillerie lourde + la cavalerie + l'infanterie de marine?
Ton code est très fonctionnel, mais quid en cas de nombreuses lignes + nombreux Areas?

Je sais bien que ce n'est pas ce que demande le demandeur, mais, par exemple, teste avec ceci comme base :

Code :

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

1
2
3
4
5
6
7
8
9
Sub Rempli()
Dim TB(1 To 60000, 1 To 2), i&, j&
Cells.Clear
For i = 1 To UBound(TB, 1)
    If i Mod 5 = 1 Then TB(i, 1) = "A" & i
    TB(i, 2) = "B" & i
Next i
Range("A1").Resize(UBound(TB, 1), 2) = TB
End Sub

Les quelques 12 000 dictionary créés ont fait tourner la tête de mon pauvre Excel...

[Pierre Fauconnier]

Oui, je sais. J'aurais dû être plus précis: "Sans aucune explication, la réponse renvoyant à Transpose ne sert pas grand chose..."

Cela dit, je ne suis pas certain que ce soit plus simple et/ou plus intuitif en une boucle avec Transpose qu'en deux sans Transpose. Mais ça, c'est une considération personnelle.

[pijaku]

Pas de souci Pierre.
Je trouve néanmoins, ma solution intéressante au niveau de l'apprentissage des propriétés des objets Range : Resize, Offset, End.

Voici un second jet avec moins de variables :

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
Sub essai2()
Dim RngInit As Range, Plage As Range, RngRestit As Range
 
    Set RngInit = Range("A1")
    Set RngRestit = Range("D1")
    Do
        If RngInit.End(xlDown).Row = Rows.Count Then Exit Do
        Set Plage = Range(RngInit, RngInit.End(xlDown).Offset(-1, 0)).Resize(, 2)
        RngRestit.Value = Plage.Cells(1, 1).Value
        RngRestit.Offset(0, 1).Resize(, Plage.Rows.Count) = WorksheetFunction.Transpose(Plage.Columns(2))
        Set RngInit = RngInit.End(xlDown): Set RngRestit = RngRestit.Offset(1, 0)
    Loop
    Set Plage = Range(RngInit, RngInit.Offset(0, 1).End(xlDown)).Resize(, 2)
    RngRestit.Value = Plage.Cells(1, 1).Value
    RngRestit.Offset(0, 1).Resize(, Plage.Rows.Count) = WorksheetFunction.Transpose(Plage.Columns(2))
    Set RngInit = Nothing: Set RngRestit = Nothing: Set Plage = Nothing
End Sub

[Pierre Fauconnier]

[...]Je trouve néanmoins, ma solution intéressante au niveau de l'apprentissage des propriétés des objets Range : Resize, Offset, End.[...]

[unparia]

Voilà cette discussion déplacée vers VBA.
Il m'est donc maintenant possible de montrer comment utiliser la méthode transpose dans cette "grosse affaire" :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Dim plage As Range, a As Range, fin As Integer, deb As Integer, derlig As Long
  derlig = Range("B" & Rows.Count).End(xlUp).Row
  Set plage = Range("A1:A" & derlig).SpecialCells(xlCellTypeBlanks)
  ou = 1
  For Each a In plage.Areas
    Range("D" & ou).Value = a.Offset(-1, 0).Value
    deb = a.Row - 1 '----------------------------je ne décompose que pour que l'on suive plus facilement mon raisonnement
    fin = deb + a.Rows.Count '----------------------------je ne décompose que pour que l'on suive plus facilement mon raisonnement
    Range(Cells(ou, 5), Cells(ou, 5 + fin - deb)).Value = WorksheetFunction.Transpose(Range("B" & deb & ":B" & fin))
    ou = ou + 1
  Next

L'intuitivité est comme le sont la vision des choses, les goûts, les couleurs, etc ... Elle dépend de chaque individu.
La mienne, d'intuitivité, me fait travailler par "tas" plutôt qu'avec des bûchettes utilisées comme des dominos (je suis peut-être fou)


A Franck : si je te dis, à toi, maintenant, que cette "affaire" peut également être traitée simplement (mais moins rapidement) en s'intéressant (s'intéresser n'est pas "utiliser uniquement) à la méthode d'éclatement des données par rapport à un séparateur (Range.TextToColumns) ? --->> je te laisse faire
Amitiés.

[Pierre Fauconnier]

[...]

Le problème de ce code, c'est que si on veut changer la première cellule d'arrivée, par exemple pour partir de E5 plutôt que de D1, on est obligé de modifier trois valeurs dans le code. Il serait intéressant de pouvoir déduire ces valeurs d'une cellule (ce qui n'est vraiment pas compliqué, mais ça rendrait le code plus générique, à mon avis).

Voilà donc notre demandeur avec trois solutions possibles...

[Pierre Fauconnier]

Salut Franck,

Pour répondre à ta question de ce matin 7h56, j'utiliserais le code suivant:

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
Sub Transpose()
  Dim source As Range
  Dim Value As Variant
  Dim Target As Range
  Dim Counter As Long
 
  Set source = Range("a1")
  Set Target = Range("d1")
  Counter = 2
  Do While Not IsEmpty(source)
    Target.Value = source.Value
    Target(1, Counter).Value = source(1, 2).Value
    Set source = source(2)
    Counter = Counter + 1
    If source.Value <> source(0, 1).Value Then
      Counter = 2
      Set Target = Target(2)
    End If
  Loop
End Sub