Je suis à la recherche d'une macro me permettant de faire un tri dans un fichier excel et ce en tenant compte des cellules non vides. En effet j'ai pu enregistrer une macro qui me fait un tri automatique, mais le problème est que les cellules vides se retrouvent en tête de document.
Merci pour votre aide.
Version complète : Macro pour le tri de cellules non-vides
une idée à prendre ?
A la place de faire un Select tu peux faire un Delete, voit un Cut and Paste...
;-)
A la place de faire un Select tu peux faire un Delete, voit un Cut and Paste...
;-)
CITATION(Groumphy @ 07-03-2008 - 10:53) 
une idée à prendre ?
A la place de faire un Select tu peux faire un Delete, voit un Cut and Paste...
;-)
A la place de faire un Select tu peux faire un Delete, voit un Cut and Paste...
;-)
L'idée, est que le fichier que j'ai créer est fait pour aller rechercher des données de personnes dans des feuilles et de ramener les noms des personnes vers une feuille base (formules). Ensuite de remettre par ordre chronologique ces noms. D'autre part, j'ai introduit sur chaque cellules dans la page de base un lien hypertexte afin de faciliter la recherche et de retourner rapidement vers la personne désirée et j'ai tout blindé (bouton et macro de commande de tri quand le fichier est protégé), car l'utilisateur de ce fichier ne connaît absolument rien à excel et je ne voudrais pas que le fichier déconne à cause de cela.
Bonjour Inguyone, Groumphy
Tiens, Grouphy, je t'avais jamais vu sur XLD ?
inguyone: cette vieille procédure classique enlève les doublons de la colonne A:A et les trie en ordre crossant, qu'il y ait des vides ou pas
A toi d'adapter (tu n'as peut être pas de doublons)
A+
Michel
Tiens, Grouphy, je t'avais jamais vu sur XLD ?
inguyone: cette vieille procédure classique enlève les doublons de la colonne A:A et les trie en ordre crossant, qu'il y ait des vides ou pas
CODE
Option Explicit
Option Base 1
Sub epurer_trier()
Dim triage As Collection
Dim nbre As Long, cptr As Long, i As Long, j As Long, k As Long
Dim tmp
Dim alpha()
'ActiveSheet.Unprotect
Application.ScreenUpdating = False
nbre = Application.CountA(Range("A:A"))
Set triage = New Collection
'-------------ELIMINATIONS DES DOUBLONS ET VIDES
On Error Resume Next
cptr = 1
While cptr <= nbre
If Cells(cptr, 1) <> "" Then
triage.Add Cells(cptr, 1).Value, CStr(Cells(cptr, 1).Value)
End If
cptr = cptr + 1
Wend
On Error GoTo 0
'--------------------------TRI CROISSANT
nbre = triage.Count
ReDim alpha(nbre)
cptr = 1
While cptr <= nbre
alpha(cptr) = triage(cptr)
cptr = cptr + 1
Wend
For i = 1 To nbre
j = i
For k = j + 1 To nbre
If alpha(k) <= alpha(j) Then j = k
Next k
If i <> j Then
tmp = alpha(j)
alpha(j) = alpha(i)
alpha(i) = tmp
End If
Next i
Range("A:A").ClearContents
cptr = 1
While cptr <= nbre
Cells(cptr, 1) = alpha(cptr)
cptr = cptr + 1
Wend
End Sub
Option Base 1
Sub epurer_trier()
Dim triage As Collection
Dim nbre As Long, cptr As Long, i As Long, j As Long, k As Long
Dim tmp
Dim alpha()
'ActiveSheet.Unprotect
Application.ScreenUpdating = False
nbre = Application.CountA(Range("A:A"))
Set triage = New Collection
'-------------ELIMINATIONS DES DOUBLONS ET VIDES
On Error Resume Next
cptr = 1
While cptr <= nbre
If Cells(cptr, 1) <> "" Then
triage.Add Cells(cptr, 1).Value, CStr(Cells(cptr, 1).Value)
End If
cptr = cptr + 1
Wend
On Error GoTo 0
'--------------------------TRI CROISSANT
nbre = triage.Count
ReDim alpha(nbre)
cptr = 1
While cptr <= nbre
alpha(cptr) = triage(cptr)
cptr = cptr + 1
Wend
For i = 1 To nbre
j = i
For k = j + 1 To nbre
If alpha(k) <= alpha(j) Then j = k
Next k
If i <> j Then
tmp = alpha(j)
alpha(j) = alpha(i)
alpha(i) = tmp
End If
Next i
Range("A:A").ClearContents
cptr = 1
While cptr <= nbre
Cells(cptr, 1) = alpha(cptr)
cptr = cptr + 1
Wend
End Sub
A toi d'adapter (tu n'as peut être pas de doublons)
A+
Michel
CITATION(michel_m @ 09-03-2008 - 10:28)
Bonjour Inguyone, Groumphy
Tiens, Grouphy, je t'avais jamais vu sur XLD ?
inguyone: cette vieille procédure classique enlève les doublons de la colonne A:A et les trie en ordre crossant, qu'il y ait des vides ou pas
A toi d'adapter (tu n'as peut être pas de doublons)
A+
Michel
Tiens, Grouphy, je t'avais jamais vu sur XLD ?
inguyone: cette vieille procédure classique enlève les doublons de la colonne A:A et les trie en ordre crossant, qu'il y ait des vides ou pas
CODE
Option Explicit
Option Base 1
Sub epurer_trier()
Dim triage As Collection
Dim nbre As Long, cptr As Long, i As Long, j As Long, k As Long
Dim tmp
Dim alpha()
'ActiveSheet.Unprotect
Application.ScreenUpdating = False
nbre = Application.CountA(Range("A:A"))
Set triage = New Collection
'-------------ELIMINATIONS DES DOUBLONS ET VIDES
On Error Resume Next
cptr = 1
While cptr <= nbre
If Cells(cptr, 1) <> "" Then
triage.Add Cells(cptr, 1).Value, CStr(Cells(cptr, 1).Value)
End If
cptr = cptr + 1
Wend
On Error GoTo 0
'--------------------------TRI CROISSANT
nbre = triage.Count
ReDim alpha(nbre)
cptr = 1
While cptr <= nbre
alpha(cptr) = triage(cptr)
cptr = cptr + 1
Wend
For i = 1 To nbre
j = i
For k = j + 1 To nbre
If alpha(k) <= alpha(j) Then j = k
Next k
If i <> j Then
tmp = alpha(j)
alpha(j) = alpha(i)
alpha(i) = tmp
End If
Next i
Range("A:A").ClearContents
cptr = 1
While cptr <= nbre
Cells(cptr, 1) = alpha(cptr)
cptr = cptr + 1
Wend
End Sub
Option Base 1
Sub epurer_trier()
Dim triage As Collection
Dim nbre As Long, cptr As Long, i As Long, j As Long, k As Long
Dim tmp
Dim alpha()
'ActiveSheet.Unprotect
Application.ScreenUpdating = False
nbre = Application.CountA(Range("A:A"))
Set triage = New Collection
'-------------ELIMINATIONS DES DOUBLONS ET VIDES
On Error Resume Next
cptr = 1
While cptr <= nbre
If Cells(cptr, 1) <> "" Then
triage.Add Cells(cptr, 1).Value, CStr(Cells(cptr, 1).Value)
End If
cptr = cptr + 1
Wend
On Error GoTo 0
'--------------------------TRI CROISSANT
nbre = triage.Count
ReDim alpha(nbre)
cptr = 1
While cptr <= nbre
alpha(cptr) = triage(cptr)
cptr = cptr + 1
Wend
For i = 1 To nbre
j = i
For k = j + 1 To nbre
If alpha(k) <= alpha(j) Then j = k
Next k
If i <> j Then
tmp = alpha(j)
alpha(j) = alpha(i)
alpha(i) = tmp
End If
Next i
Range("A:A").ClearContents
cptr = 1
While cptr <= nbre
Cells(cptr, 1) = alpha(cptr)
cptr = cptr + 1
Wend
End Sub
A toi d'adapter (tu n'as peut être pas de doublons)
A+
Michel
Michel,
Merci pour ton aide, mais en temps que novice dans l'utilisation des macros, j'ai pas mal de soucis d'exécution et donc je vais maintenant me prendre la tête afin de mettre tout ceci en application.
A plus.
re,
N'hésites pas au cas où...
Bon courage!
N'hésites pas au cas où...
Bon courage!
@ Inguyone >> Il semble que tu n'aies pas suivis le lien... Mais vu que Michel te donne la réponse...
@ Michel >> Normal, je ne fais que lire les messages...
Je ne participe pas, on peut pas tout faire non plus ! 
@ Michel >> Normal, je ne fais que lire les messages...
Je ne participe pas, on peut pas tout faire non plus !
Ceci une version "bas débit" de notre forum. Pour voir la version complète avec plus d'information, la mise en page et les images, veuillez cliquez ici.