TRI DE DONNEES PARTICULIEREMENT DIFFICILE

michdenis

24/01/2009 à 04:03

Un clic droit sur l'onglet de la feuille où sont les données
et tu copies cette procédure dans la page blanche
et tu l'adaptes à ton application

'----------------------------------------
Sub test()
Dim rg As Range, R As Range, DerCol As Integer
Dim NbColonne As Integer, X

'Nombre de colonne de la plage
'contenant des données
NbColonne = 5 'à renseigner

With Me
'Modifie .Range("E26:E" & .Range("E65536")
'par la Lettre appropriée, E26 cellule de départ
'et l'adresse de la première cellule de
'la plage concernée
Set rg = .Range("E26:E" & .Range("E65536"). _
End(xlUp).Row).Resize(, NbColonne)
End With

'Application du filtre sur chaque ligne
For Each R In rg.Rows
R.Sort Key1:=R.Cells(1, 1), Order1:=xlAscending _
, Header:=xlYes, Orientation:=xlLeftToRight
Next
'Transforme le mode vertical vers le mode horizontal
With rg
X = .Value
.Clear
End With
rg.Cells(1, 1).Resize(UBound(X, 2), UBound(X, 1)) = _
Application.Transpose(X)
End Sub
'----------------------------------------

"BOVY SA" a écrit dans le message de groupe de
discussion :
BONJOUR,

J'AI DES DONNEES SUR PLUSIEURS COLONNES
DANS LA PREMIERE DES REFERENCES AVEC DOUBLONS CAR SE REFERENT A UNE COLLONNE
TOUJOURS DIFFERENTE ET JE SOUHAITE ELIMINER LES BLANCS ET CREER UNE FEUILLE
SANS DOUBLON DANS LA PREMIERE COLONNE :
COLONNE A B C D E
625R | 625S | | |
625R | | 625L | |
625R | | | 625D |
625R | | | | 625N

RESULTAT :

COLONNE A | B | C | D | E
625R | 625S | 625L | 625D | 625N

QUELQU'UN CONNAIT-IL LA MARCHE A SUIVRE ??????
MERCI D'AVANCE

BOVYSA

Mishell

24/01/2009 à 15:37

Bonjour.

Set rg = Range("$E$26:$I$29")

'rg.Select
ligne = rg.Rows.Count
colonne = rg.Columns.Count
For i = rg.Column To rg.Column + colonne - 1
Set r = Range(Cells(rg.Row, i), Cells(rg.Row + ligne - 1, i))
'r.Select
r.Sort Key1:Îlls(rg.Row, i), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom

Next

Set r = Range(Cells(rg.Row + 1, rg.Column), Cells(rg.Row + ligne - 1,
rg.Column + colonne - 1))
'r.Select
r.ClearContents

Mishell

"BOVY SA" wrote in message
news:

Jimmy

24/01/2009 à 16:44

"BOVY SA" a écrit dans le message de
news:

Bonjour,

pouvez-vous parler moins fort

Merci
Jimmy

BOVY SA

25/01/2009 à 01:30

Bonsoir,

Merci beaucoup pour votre proposition mais elle ne résoud pas
mon problème ....

Voici mon fichier
http://cjoint.com/?bBbxvYyvvQ

BOVYSA

"michdenis" a écrit :

BOVY SA

25/01/2009 à 01:31

Bonsoir,

Merci beaucoup pour votre proposition mais elle ne résoud pas
mon problème ....

Voici mon fichier
http://cjoint.com/?bBbxvYyvvQ

BOVYSA
"Mishell" a écrit :

michdenis

25/01/2009 à 03:15

Je joins une copie du fichier... il fonctionne très bien
http://cjoint.com/?bBdeLBnHGV

A ) Si tu veux transposer Les Colonnes "A1:B3026" de façon
horizontale, tu es mieux de posséder Excel 2007.
Excel 2003 est limitée à 256 colonnes.

B ) Le fichier que je t'ai envoyé était enregistré au format excel 1997-2003
car je crois que c'est le format encore le plus utilisé et d'après ton
exemple, je ne pouvais pas me douter que le fichier originale avait
"autant de données"

C ) quant tu as excel 2007 et que tu ouvres un fichier au
format xls(1997-2003), tu te retrouves en mode compatibilité
Tu dois enregistrer le fichier reçu au format 2007 soit "xlsm"

Tu fermes le fichier et à sa réouverture, tu as vraiment un fichier
au format excel 2007.

Dans ces circonstances, le fichier fonctionne très bien.

P.S - Faudrait quand même que tu fasses un minimum d'effort lorsque
vient le temps de commenter les difficultés que tu rencontres avec le
matériel que les bénévoles te procurent. Nous sommes un groupe
d'entraide ... nous te faisons des suggestions - c'est pas notre rôle de
faire le travail à ta place !!!!!!!!!!!!!!!!!!!!!!!!!!!!

"BOVY SA" a écrit dans le message de groupe de
discussion :
Bonsoir,

Merci beaucoup pour votre proposition mais elle ne résoud pas
mon problème ....

Voici mon fichier
http://cjoint.com/?bBbxvYyvvQ

BOVYSA

"michdenis" a écrit :

Je joins une copie du fichier... il fonctionne très bien
http://cjoint.com/?bBdeLBnHGV

A ) Si tu veux transposer Les Colonnes "A1:B3026" de façon
horizontale, tu es mieux de posséder Excel 2007.
Excel 2003 est limitée à 256 colonnes.

B ) Le fichier que je t'ai envoyé était enregistré au format excel 1997-2003
car je crois que c'est le format encore le plus utilisé et d'après ton
exemple, je ne pouvais pas me douter que le fichier originale avait
"autant de données"

C ) quant tu as excel 2007 et que tu ouvres un fichier au
format xls(1997-2003), tu te retrouves en mode compatibilité
Tu dois enregistrer le fichier reçu au format 2007 soit "xlsm"

Tu fermes le fichier et à sa réouverture, tu as vraiment un fichier
au format excel 2007.

Dans ces circonstances, le fichier fonctionne très bien.

P.S - Faudrait quand même que tu fasses un minimum d'effort lorsque
vient le temps de commenter les difficultés que tu rencontres avec le
matériel que les bénévoles te procurent. Nous sommes un groupe
d'entraide ... nous te faisons des suggestions - c'est pas notre rôle de
faire le travail à ta place !!!!!!!!!!!!!!!!!!!!!!!!!!!!

"BOVY SA" <BOVYSA@discussions.microsoft.com> a écrit dans le message de groupe de
discussion : F1A58B2D-1666-4E4B-9A70-E9FCB34DA205@microsoft.com...
Bonsoir,

Merci beaucoup pour votre proposition mais elle ne résoud pas
mon problème ....

Voici mon fichier
http://cjoint.com/?bBbxvYyvvQ

BOVYSA

"michdenis" a écrit :

Vous avez filtré cet utilisateur ! Consultez son message

Je joins une copie du fichier... il fonctionne très bien
http://cjoint.com/?bBdeLBnHGV

A ) Si tu veux transposer Les Colonnes "A1:B3026" de façon
horizontale, tu es mieux de posséder Excel 2007.
Excel 2003 est limitée à 256 colonnes.

B ) Le fichier que je t'ai envoyé était enregistré au format excel 1997-2003
car je crois que c'est le format encore le plus utilisé et d'après ton
exemple, je ne pouvais pas me douter que le fichier originale avait
"autant de données"

C ) quant tu as excel 2007 et que tu ouvres un fichier au
format xls(1997-2003), tu te retrouves en mode compatibilité
Tu dois enregistrer le fichier reçu au format 2007 soit "xlsm"

Tu fermes le fichier et à sa réouverture, tu as vraiment un fichier
au format excel 2007.

Dans ces circonstances, le fichier fonctionne très bien.

P.S - Faudrait quand même que tu fasses un minimum d'effort lorsque
vient le temps de commenter les difficultés que tu rencontres avec le
matériel que les bénévoles te procurent. Nous sommes un groupe
d'entraide ... nous te faisons des suggestions - c'est pas notre rôle de
faire le travail à ta place !!!!!!!!!!!!!!!!!!!!!!!!!!!!

"BOVY SA" a écrit dans le message de groupe de
discussion :
Bonsoir,

Merci beaucoup pour votre proposition mais elle ne résoud pas
mon problème ....

Voici mon fichier
http://cjoint.com/?bBbxvYyvvQ

BOVYSA

"michdenis" a écrit :

michdenis

25/01/2009 à 04:54

Ceci aurait été suffisant comme macro :

à Copier dans un module et à adapter le nom de la feuille
'-------------------------------
Sub test2()
On Error Resume Next
Application.ScreenUpdating = False
With Worksheets("Feuil1") ' à adapter
With .Range("A1:E" & .Range("A65536").End(xlUp).Row)
.SpecialCells(xlCellTypeBlanks).Delete
.Item(1, 1).Resize(2, .Rows.Count) = _
Application.Transpose(.Item(1, 1).Resize(.Rows.Count, 2))
.Offset(2).Clear
End With
End With
End Sub
'-------------------------------

"BOVY SA" a écrit dans le message de groupe de
discussion :
Bonsoir,

Merci beaucoup pour votre proposition mais elle ne résoud pas
mon problème ....

Voici mon fichier
http://cjoint.com/?bBbxvYyvvQ

BOVYSA

"michdenis" a écrit :

Ceci aurait été suffisant comme macro :

à Copier dans un module et à adapter le nom de la feuille
'-------------------------------
Sub test2()
On Error Resume Next
Application.ScreenUpdating = False
With Worksheets("Feuil1") ' à adapter
With .Range("A1:E" & .Range("A65536").End(xlUp).Row)
.SpecialCells(xlCellTypeBlanks).Delete
.Item(1, 1).Resize(2, .Rows.Count) = _
Application.Transpose(.Item(1, 1).Resize(.Rows.Count, 2))
.Offset(2).Clear
End With
End With
End Sub
'-------------------------------

"BOVY SA" <BOVYSA@discussions.microsoft.com> a écrit dans le message de groupe de
discussion : F1A58B2D-1666-4E4B-9A70-E9FCB34DA205@microsoft.com...
Bonsoir,

Merci beaucoup pour votre proposition mais elle ne résoud pas
mon problème ....

Voici mon fichier
http://cjoint.com/?bBbxvYyvvQ

BOVYSA

"michdenis" a écrit :

Vous avez filtré cet utilisateur ! Consultez son message

Ceci aurait été suffisant comme macro :

à Copier dans un module et à adapter le nom de la feuille
'-------------------------------
Sub test2()
On Error Resume Next
Application.ScreenUpdating = False
With Worksheets("Feuil1") ' à adapter
With .Range("A1:E" & .Range("A65536").End(xlUp).Row)
.SpecialCells(xlCellTypeBlanks).Delete
.Item(1, 1).Resize(2, .Rows.Count) = _
Application.Transpose(.Item(1, 1).Resize(.Rows.Count, 2))
.Offset(2).Clear
End With
End With
End Sub
'-------------------------------

"BOVY SA" a écrit dans le message de groupe de
discussion :
Bonsoir,

Merci beaucoup pour votre proposition mais elle ne résoud pas
mon problème ....

Voici mon fichier
http://cjoint.com/?bBbxvYyvvQ

BOVYSA

"michdenis" a écrit :

Mishell

25/01/2009 à 07:44

Si j'ai bien compris, ceci fera le classement. Il ne reste plus qu'à
supprimer les lignes qui ne contiennent rien sauf la valeur dans la colonne
A.

Sub test3()
Dim premiere As Long
Dim y As Long
Dim i As Long
Dim derniereligne As Long

derniereligne = [a1].End(xlDown).Row

premiere = 1
precedent = Cells(premiere, 1)

For y = 1 To derniereligne
If Cells(y, 1) <> precedent Then

Set cellule1 = Cells(premiere, 1)
Set cellule2 = Cells(y - 1, 5)

Set rg = Range(cellule1, cellule2)
'rg.Select

If Not premiere < y - 1 Then
premiere = y
precedent = Cells(premiere, 1)
Else
premiere = y
precedent = Cells(premiere, 1)

ligne = rg.Rows.Count
colonne = rg.Columns.Count
For i = rg.Column To rg.Column + colonne - 1
Set r = Range(Cells(rg.Row, i), Cells(rg.Row + ligne - 1, i))
'r.Select
r.Sort Key1:Îlls(rg.Row, i), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom

Next

'Set r = Range(Cells(rg.Row + 1, rg.Column), Cells(rg.Row + ligne - 1,
rg.Column + colonne - 1))
'r.Select

End If

End If
Next
End Sub

"BOVY SA" wrote in message
news:

Si j'ai bien compris, ceci fera le classement. Il ne reste plus qu'à
supprimer les lignes qui ne contiennent rien sauf la valeur dans la colonne
A.

Sub test3()
Dim premiere As Long
Dim y As Long
Dim i As Long
Dim derniereligne As Long

derniereligne = [a1].End(xlDown).Row

premiere = 1
precedent = Cells(premiere, 1)

For y = 1 To derniereligne
If Cells(y, 1) <> precedent Then

Set cellule1 = Cells(premiere, 1)
Set cellule2 = Cells(y - 1, 5)

Set rg = Range(cellule1, cellule2)
'rg.Select

If Not premiere < y - 1 Then
premiere = y
precedent = Cells(premiere, 1)
Else
premiere = y
precedent = Cells(premiere, 1)

ligne = rg.Rows.Count
colonne = rg.Columns.Count
For i = rg.Column To rg.Column + colonne - 1
Set r = Range(Cells(rg.Row, i), Cells(rg.Row + ligne - 1, i))
'r.Select
r.Sort Key1:Îlls(rg.Row, i), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom

Next

'Set r = Range(Cells(rg.Row + 1, rg.Column), Cells(rg.Row + ligne - 1,
rg.Column + colonne - 1))
'r.Select

End If

End If
Next
End Sub

"BOVY SA" <BOVYSA@discussions.microsoft.com> wrote in message
news:7912D130-32B4-4750-853C-65C833A60EA1@microsoft.com...

Vous avez filtré cet utilisateur ! Consultez son message

Si j'ai bien compris, ceci fera le classement. Il ne reste plus qu'à
supprimer les lignes qui ne contiennent rien sauf la valeur dans la colonne
A.

Sub test3()
Dim premiere As Long
Dim y As Long
Dim i As Long
Dim derniereligne As Long

derniereligne = [a1].End(xlDown).Row

premiere = 1
precedent = Cells(premiere, 1)

For y = 1 To derniereligne
If Cells(y, 1) <> precedent Then

Set cellule1 = Cells(premiere, 1)
Set cellule2 = Cells(y - 1, 5)

Set rg = Range(cellule1, cellule2)
'rg.Select

If Not premiere < y - 1 Then
premiere = y
precedent = Cells(premiere, 1)
Else
premiere = y
precedent = Cells(premiere, 1)

ligne = rg.Rows.Count
colonne = rg.Columns.Count
For i = rg.Column To rg.Column + colonne - 1
Set r = Range(Cells(rg.Row, i), Cells(rg.Row + ligne - 1, i))
'r.Select
r.Sort Key1:Îlls(rg.Row, i), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom

Next

'Set r = Range(Cells(rg.Row + 1, rg.Column), Cells(rg.Row + ligne - 1,
rg.Column + colonne - 1))
'r.Select

End If

End If
Next
End Sub

"BOVY SA" wrote in message
news:

TRI DE DONNEES PARTICULIEREMENT DIFFICILE

8 réponses

Veuillez sélectionner un problème