Transposition automatique selon règle

Fermé
califmeg27 Messages postés 2 Date d'inscription mardi 25 janvier 2011 Statut Membre Dernière intervention 27 janvier 2011 - 25 janv. 2011 à 14:03
califmeg27 Messages postés 2 Date d'inscription mardi 25 janvier 2011 Statut Membre Dernière intervention 27 janvier 2011 - 27 janv. 2011 à 13:30
Bonjour,
Je suis débutante en VBA et cela fait plus d'une semaine que je bute sur un problème malgré mes nombreuses recherches...
En fait, je dispose d'une liste de 10000 références que je souhaite transposer en fonction de leur préfixe. Je souhaite que toutes les références ayant le même préfixe (composé de 6 chiffres) soit transposées sur la même ligne.
Le fichier vous permettra de me comprendre car je suis pas sur d'être bien claire....

2 réponses

Bonjour,

essaie ce code en l'adaptant. Appui sur F8, tu verras les actions

Sub Macro1()
'
' Macro1 Macro
' Macro recorded 26/01/2011 by DLPINTERNETTEST3
'

'
Sheets("Sheet1").Select 'ta feuille de travail remplace sheet1 par ton nom de feuille
Columns("A:B").Select ' le classement de ton tableau, sélectionne les colonnes de A à b
'si tu as un en-tête :
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
'si tu n'as pas d'en-tête :
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

i = 1 ' ta ligne ou se trouve ta première référence, si c'est pas 1 mets le numéro de ligne
j = 1 ' ta colonne ou se trouve ta référence si c'est en B mets 2, si c'est en c, mets 3....
a = i + 1
Do While Cells(i, 1) <> "" 'balaie jusqu'à ce que tu n'ais plus de références
If Cells(i, 1) = Cells(a, 1) Then 'compare deux réfrences sur deux lignes
j = 2
Do While Cells(i, j) <> ""
j = j + 1
Loop
Cells(i, j) = Cells(a, 1) 'si c'est égal on la mets sur la même ligne
Rows(a).Select
Selection.Delete Shift:=xlUp 'on supprime la référence doublon
Else
i = i + 1
a = i + 1
End If
Loop



End Sub
0
califmeg27 Messages postés 2 Date d'inscription mardi 25 janvier 2011 Statut Membre Dernière intervention 27 janvier 2011
27 janv. 2011 à 13:30
Bonjour mélanie,

Je te remercie vivement pour ton code mais d'une part je n'arrive pas à le compiler et d'autre part cela ne résoud pas mon problème puisque je n'ai pas une seuls fois la meme cellules mais des cellules du types "123456-OF", "123456-ON"... Et c'est ces références qui commencent par le même préfixe (ici 123456) que je veux transposer automatiquement.
Désolée, je ne suis certainement pas assez claire...

Mymy
0