Transposer colonne -> Ligne, suivant valeur colonne A

flint6593

XLDnaute Occasionnel
Bonjour à tous!

Si quelqu'un pouvait m'aider, vous me sauveriez la nuit :eek:

Voilà mon soucis:
- Colonne A j'ai des références
- Colonne B j'ai des prix

Il y a plusieurs fois la même références colonne A, car dans la colonne B j'ai l'évolution des prix.

Ce que je voudrais c'est pour chaque référence, transposer tous les prix sur une seule et unique ligne.
De manière à avoir sur une seule ligne, la référence puis toutes les évolutions de prix.

J'ai ce type de traitement à faire pour des milliers d'articles...

Je vous met un exemple pour que se soit plus claire.
J'ai mis des onglet Avant/Après...

Merci d'avance!!!!

Flint!
 

Pièces jointes

  • Ref et prix.xls
    37.5 KB · Affichages: 62

flint6593

XLDnaute Occasionnel
Re : Transposer colonne -> Ligne, suivant valeur colonne A

Bon bein après m'être cassé un peu la tête voici mon code qui fonctionne, peut-être que ça servira à d'autres:

Sub Macro1()

dim i
dim j
dim ctp_ligne

Sheets("Feuil1").Select 'A MODIFIER
i = 2
j = 1

Do While Range("A" & i).Value <> ""

ctp_ligne = i + 1

Sheets("Feuil1").Select 'A MODIFIER

Do While Range("A" & ctp_ligne).Value = Range("A" & i).Value
ctp_ligne = ctp_ligne + 1
Loop

Range("B" & i & ":B" & (ctp_ligne - 1)).Select
Selection.Copy

Sheets("Feuil2").Select 'A MODIFIER
Range("B" & j).Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True

'copie 1ère ligne
Sheets("Feuil1").Select 'A MODIFIER
Range("A" & i).Select
Selection.Copy

Sheets("Feuil2").Select 'A MODIFIER
Range("A" & j).Select
ActiveSheet.Paste

j = j + 1

i = ctp_ligne
Sheets("Feuil1").Select 'A MODIFIER
Loop

MsgBox "Transposition Terminer - SG1 Terminé!"
End Sub

Bonne soirée!
 

job75

XLDnaute Barbatruc
Re : Transposer colonne -> Ligne, suivant valeur colonne A

Bonsoir flint 6593,

Formule matricielle en A2 :

Code:
=INDEX(Ref;PETITE.VALEUR(SI(Ref<>DECALER(Ref;-1;);LIGNE(Ref)-1);LIGNE()-1))
A valider par Ctrl+Maj+Entrée et tirer vers le bas.

Formule normale en B2, à tirer à droite et vers le bas :

Code:
=SI(COLONNE()-1>NB.SI(Ref;$A2);"";INDEX(DECALER(Prix;EQUIV($A2;Ref;0)-1;;NB.SI(Ref;$A2));COLONNE()-1))
Voyez les noms définis Ref et Prix.

Fichier joint.

A+
 

Pièces jointes

  • Ref et prix(1).xls
    81 KB · Affichages: 54

job75

XLDnaute Barbatruc
Re : Transposer colonne -> Ligne, suivant valeur colonne A

Bonjour le forum,

Pour être complet :

- cette formule (matricielle) en A2 évite les valeurs d'erreur :

Code:
=SI(LIGNE()-1>ARRONDI(SOMME(1/NB.SI(Ref;Ref)););"";INDEX(Ref;PETITE.VALEUR(SI(Ref<>DECALER(Ref;-1;);LIGNE(Ref)-1);LIGNE()-1)))
- pour la formule en B2 il était inutile de déterminer la plage avec DECALER :

Code:
=SI(COLONNE()-1>NB.SI(Ref;$A2);"";INDEX(Prix;EQUIV($A2;Ref;0)+COLONNE()-2))
Fichier (2).

Nota : j'ai oublié de préciser que bien entendu le tableau source doit être trié sur la 1ère colonne (Ref).

A+
 

Pièces jointes

  • Ref et prix(2).xls
    179.5 KB · Affichages: 55
Dernière édition:

job75

XLDnaute Barbatruc
Re : Transposer colonne -> Ligne, suivant valeur colonne A

Re,

Une solution VBA, très rapide même sur un grand tableau.

En effet elle utilise des tableaux VBA :

Code:
Private Sub Worksheet_Activate()
Dim lig&, col%, tablo1, tablo2(), i&
[Ref].Resize(, 2).Sort [Ref], Header:=xlYes 'tri
lig = Evaluate("SUMPRODUCT(N(Ref<>OFFSET(Ref,1,)))")
col = Evaluate("MAX(COUNTIF(Ref,Ref))") + 1
tablo1 = [Ref].Resize(, 2) 'matrice, plus rapide
ReDim tablo2(1 To lig, 1 To col)
lig = 1
For i = 2 To UBound(tablo1)
  If tablo1(i, 1) <> tablo1(i - 1, 1) Then
    lig = lig + 1
    col = 1
    tablo2(lig, 1) = tablo1(i, 1)
  End If
  col = col + 1
  tablo2(lig, col) = tablo1(i, 2)
  tablo2(1, col) = col - 1
Next
tablo2(1, 1) = "Référence"
Cells.Resize(lig, col) = tablo2
Rows(lig + 1 & ":" & Rows.Count).ClearContents
Range(Columns(col + 1), Columns(Columns.Count)).ClearContents
End Sub
La macro se déclenche quand on active la 2ème feuille.

Fichier joint.

Nota : j'ai modifié la formule du nom défini Ref.

Edit : ajouté une MFC en ligne 1 de la 2ème feuille.

A+
 

Pièces jointes

  • Ref et prix VBA(1).xls
    58 KB · Affichages: 67
Dernière édition:

Discussions similaires

Réponses
7
Affichages
348

Statistiques des forums

Discussions
312 489
Messages
2 088 852
Membres
103 974
dernier inscrit
chmikha