XL 2010 transposer plusieurs lignes-même ID

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion djam28
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
D

djam28

XLDnaute Occasionnel
Bonsoir à tous,
Je fais appel à vos lumières pour résoudre un souci de traitement de données. Mon problème est le suivant:
J'ai une base de donnée contenant des patients en doublant. chaque doublon (ligne du meme id) correspond à un événement (il pourrait en avoir plusieurs). Je voudrais que les données des doublons soient transposer sur une seule ligne (ligne = eligibily_enrol_arm1). J'ai mis un code couleur pour mettre en évidence les cutoff des colonnes
Le resultat souhaité est dans l'onglet 2 (=resultat)
Dites moi si vous voulez plus de précisions
Merci beaucoup+++
Bonne soirée
DE
 

Pièces jointes

Trier par date Trier par votes
Bonsoir djam28, yal,

Une autre méthode dans le fichier joint :
VB: 
Private Sub Worksheet_Activate()
Dim P As Range, Q As Range, n&
With Sheets("REDCAP")
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    Set P = .[A1].CurrentRegion.EntireRow.Cells
    Set Q = .[A:J,K:EB,EC:FZ,GA:NC,ND:PC] 'plages à adapter
End With
Application.ScreenUpdating = False
Cells.Clear 'RAZ
For n = 1 To Q.Areas.Count
    P.AutoFilter 2, P(n + 1, 2) 'filtre automatique
    Intersect(P, Q.Areas(n)).Copy Range(Q.Areas(n)(1).Address)
    P.AutoFilter
Next n
End Sub
La macro est dans le module de la feuille RESULTAT et se déclenche automatiquement quand on active cette feuille.

Nota : dans la 1ère feuille les évènements de B2 à B6 doivent correspondre aux 5 zones de la ligne 1.

Et l'évènement en B2 doit être celui qui occupe le plus de lignes.

Edit : j'ai supprimé .SpecialCells(xlCellTypeVisible) qui était inutile.

Bonne nuit.
 

Pièces jointes

Dernière édition:
Vote positif 0 Vote négatif
Bonjour à tous 🙂 ,

Une pensée pour nos amis adeptes du MAC donc sans dictionary.
Cela doit fonctionner quelque soit la taille des différentes parties en colonne. On ne définit pas les partitions en colonne.
La feuille RECAP se met à jour à chaque fois qu'on l'active.
Le code est dans le module de la feuille RECAP.

@job75 a repéré des erreurs dans mon premier code. Je les ai corrigées. Le fichier v2 inclus les corrections.
 

Pièces jointes

Dernière édition:
Vote positif 0 Vote négatif
Bonjour @job75 🙂
job75 à dit:
@mapomme : dans la zone EC:FZ tu récupères 3 lignes alors qu'il n'y en a que 2.

Et dans la zone GA:NC tu en récupères 2 alors qu'il n'y en a qu'une.
Cliquez pour agrandir...
Bravo et merci d'avoir repérer mes erreurs. Ce sont des erreurs grossières aussi grosses que moi.
J'en ai profité pour simplifier mon code (pas autant que le tien 😉)
J'ai aussi remplacé le fichier de mon message #5.
Le code:
VB: 
Private Sub Worksheet_Activate()
Dim F, dercol&, derlig&, n&, i&, k&, Id, nref&, nlig&, col
   Application.ScreenUpdating = False: Set F = Worksheets("REDCAP")
   If F.FilterMode Then F.ShowAllData
   derlig = F.Cells(Rows.Count, "a").End(xlUp).Row
   dercol = F.Cells(1, Columns.Count).End(xlToLeft).Column
   ReDim ref(1 To derlig, 1 To 1)
   Columns(1).Resize(, dercol).Clear
   For i = 1 To derlig
      Id = F.Cells(i, "a"): n = 0: col = "c"
      For k = 1 To nref
         If ref(k, 1) = Id Then n = k: Exit For
      Next k
      If n = 0 Then nref = nref + 1: ref(nref, 1) = Id: n = nref: nlig = nlig + 1: col = "a"
      F.Cells(i, col).Resize(, dercol - IIf(col = "c", -2, 0)).Copy
      Cells(n, col).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
   Next i
   Application.Goto Range("a1"), True
End Sub

edit: bonjour @Usine à gaz
 

Pièces jointes

Dernière édition:
Vote positif 0 Vote négatif
job75 à dit:
Bonsoir djam28, yal,

Une autre méthode dans le fichier joint :
VB: 
Private Sub Worksheet_Activate()
Dim P As Range, Q As Range, n&
With Sheets("REDCAP")
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    Set P = .[A1].CurrentRegion.EntireRow.Cells
    Set Q = .[A:J,K:EB,EC:FZ,GA:NC,ND:PC] 'plages à adapter
End With
Application.ScreenUpdating = False
Cells.Clear 'RAZ
For n = 1 To Q.Areas.Count
    P.AutoFilter 2, P(n + 1, 2) 'filtre automatique
    Intersect(P, Q.Areas(n)).Copy Range(Q.Areas(n)(1).Address)
    P.AutoFilter
Next n
End Sub
La macro est dans le module de la feuille RESULTAT et se déclenche automatiquement quand on active cette feuille.

Nota : dans la 1ère feuille les évènements de B2 à B6 doivent correspondre aux 5 zones de la ligne 1.

Et l'évènement en B2 doit être celui qui occupe le plus de lignes.

Edit : j'ai supprimé .SpecialCells(xlCellTypeVisible) qui était inutile.

Bonne nuit.
Cliquez pour agrandir...

job75 à dit:
Bonsoir djam28, yal,

Une autre méthode dans le fichier joint :
VB: 
Private Sub Worksheet_Activate()
Dim P As Range, Q As Range, n&
With Sheets("REDCAP")
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    Set P = .[A1].CurrentRegion.EntireRow.Cells
    Set Q = .[A:J,K:EB,EC:FZ,GA:NC,ND:PC] 'plages à adapter
End With
Application.ScreenUpdating = False
Cells.Clear 'RAZ
For n = 1 To Q.Areas.Count
    P.AutoFilter 2, P(n + 1, 2) 'filtre automatique
    Intersect(P, Q.Areas(n)).Copy Range(Q.Areas(n)(1).Address)
    P.AutoFilter
Next n
End Sub
La macro est dans le module de la feuille RESULTAT et se déclenche automatiquement quand on active cette feuille.

Nota : dans la 1ère feuille les évènements de B2 à B6 doivent correspondre aux 5 zones de la ligne 1.

Et l'évènement en B2 doit être celui qui occupe le plus de lignes.

Edit : j'ai supprimé .SpecialCells(xlCellTypeVisible) qui était inutile.

Bonne nuit.
Cliquez pour agrandir...
Merci
yal à dit:
Bonjour
Exactement la même que la première mais sans dictionnaire
Cliquez pour agrandir...
Merci beaucoup Yal !!
Bonne journée
DE
 
Vote positif 0 Vote négatif
mapomme à dit:
Bonjour @job75 🙂

Bravo et merci d'avoir repérer mes erreurs. Ce sont des erreurs grossières aussi grosses que moi.
J'en ai profité pour simplifier mon code (pas autant que le tien 😉)
J'ai aussi remplacé le fichier de mon message #5.
Le code:
VB: 
Private Sub Worksheet_Activate()
Dim F, dercol&, derlig&, n&, i&, k&, Id, nref&, nlig&, col
   Application.ScreenUpdating = False: Set F = Worksheets("REDCAP")
   If F.FilterMode Then F.ShowAllData
   derlig = F.Cells(Rows.Count, "a").End(xlUp).Row
   dercol = F.Cells(1, Columns.Count).End(xlToLeft).Column
   ReDim ref(1 To derlig, 1 To 1)
   Columns(1).Resize(, dercol).Clear
   For i = 1 To derlig
      Id = F.Cells(i, "a"): n = 0: col = "c"
      For k = 1 To nref
         If ref(k, 1) = Id Then n = k: Exit For
      Next k
      If n = 0 Then nref = nref + 1: ref(nref, 1) = Id: n = nref: nlig = nlig + 1: col = "a"
      F.Cells(i, col).Resize(, dercol - IIf(col = "c", -2, 0)).Copy
      Cells(n, col).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
   Next i
   Application.Goto Range("a1"), True
End Sub

edit: bonjour @Usine à gaz
Cliquez pour agrandir...
Merci mapomme
Bonne journée
DE
 
Vote positif 0 Vote négatif
job75 à dit:
Bonsoir djam28, yal,

Une autre méthode dans le fichier joint :
VB: 
Private Sub Worksheet_Activate()
Dim P As Range, Q As Range, n&
With Sheets("REDCAP")
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    Set P = .[A1].CurrentRegion.EntireRow.Cells
    Set Q = .[A:J,K:EB,EC:FZ,GA:NC,ND:PC] 'plages à adapter
End With
Application.ScreenUpdating = False
Cells.Clear 'RAZ
For n = 1 To Q.Areas.Count
    P.AutoFilter 2, P(n + 1, 2) 'filtre automatique
    Intersect(P, Q.Areas(n)).Copy Range(Q.Areas(n)(1).Address)
    P.AutoFilter
Next n
End Sub
La macro est dans le module de la feuille RESULTAT et se déclenche automatiquement quand on active cette feuille.

Nota : dans la 1ère feuille les évènements de B2 à B6 doivent correspondre aux 5 zones de la ligne 1.

Et l'évènement en B2 doit être celui qui occupe le plus de lignes.

Edit : j'ai supprimé .SpecialCells(xlCellTypeVisible) qui était inutile.

Bonne nuit.
Cliquez pour agrandir...
Bonjour Job75,
Merci infiniment
bonne journée
DE
 
Vote positif 0 Vote négatif
Dans la mesure où des données limitent correctement chaque ligne cela suffit pour repérer les zones.

Dans ce fichier (2) les limites coldeb et colfin sont trouvées par la méthode Find :
VB: 
Private Sub Worksheet_Activate()
Dim P As Range, Q As Range, nzone, n&, coldeb%, colfin%
With Sheets("REDCAP")
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    Set P = .[A1].CurrentRegion.EntireRow.Cells
    Set Q = P.Offset(1).Resize(P.Rows.Count - 1)
End With
Application.ScreenUpdating = False
Cells.Clear 'RAZ
nzone = Application.CountIf(P.Columns(1), Q(1))
For n = 1 To nzone
    P.AutoFilter 2, Q(n, 2) 'filtre automatique
    If n = 1 Then coldeb = 1 Else coldeb = Q.Find("*", Q(Q.Rows.Count, 2), xlValues, , xlByColumns, xlNext).Column
    If n = nzone Then colfin = P(1, Columns.Count).End(xlToLeft).Column Else colfin = Q.Find("*", Q(1), , , , xlPrevious).Column
    P.Columns(coldeb).Resize(, colfin - coldeb + 1).Copy Range(P(1, coldeb).Address)
    P.AutoFilter
Next n
End Sub
 

Pièces jointes

Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

D
  • Question Question
XL 2019 Concaténer plusieurs lignes à partir d'une référence en doublon
Réponses
5
Affichages
851
vgendron
vgendron
D
  • Question Question
XL 2010 fusionner 2 tableaux avec même id -macro
Réponses
11
Affichages
2 K
djam28
D
F
  • Résolu(e)
XL 2019 Power Query - Repérer lignes en double
Réponses
5
Affichages
3 K
Flx1er
F
A
  • Question Question
XL 2016 compter sans doublons avec plusieurs critères (dont 2 dans la même colonne)
2 3
Réponses
31
Affichages
4 K
Aurélie679
A
cathodique
  • Question Question
Récupérer d'un tableau valeur sans doublon
2
Réponses
17
Affichages
4 K
cathodique
cathodique
A
  • Question Question
combox en cascade qui ne se remplit pas
Réponses
5
Affichages
1 K
arthur83fr
A
M
[REF] Wiki 1 de MichelXld (Généralités Excel)
Réponses
6
Affichages
60 K
Le_Phénomène
Le_Phénomène
M
[REF] Wiki 5 de MichelXld (Formules, Audits de formules, Répertoires, Fichiers)
Réponses
0
Affichages
47 K
MichelXld
M
M
[REF] Wiki Page 9 de MichelXld
Réponses
0
Affichages
39 K
MichelXld
M
M
[REF] Wiki 6 de MichelXld (Doublons, Tris, Filtres, Variables, Fichiers fermés, Acces
Réponses
0
Affichages
68 K
MichelXld
M
M
[REF] Wiki 3 de MichelXld (Piloter d'autres applications depuis Excel)
Réponses
0
Affichages
80 K
MichelXld
M
M
[REF] Wiki Page 7 de MichelXld
Réponses
0
Affichages
51 K
MichelXld
M
M
[REF] Wiki Page 8 de MichelXld
Réponses
0
Affichages
39 K
MichelXld
M
Retour