problème VBA Tri liste personnalise

[fred94000]

Bonsoir à tous et le forum,
Je me permet de vous sollicité une fois de plus, y a t-il un autre moyen pour trier une liste de nombres. Les nombres entiers en premier et en fin les décimaux?
voir exemple fichier
La macro ci dessous ne fonctionne pas?

Sub tri()
Dim Num_List As Byte
On Error Resume Next
Num_List = Application.GetCustomListNum(Array("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15", "16", "17", "18", "19", "20",, "24", "25", "26", "27", "2 "21", "22", "23"8", "29", "30", _
31, "32", "33", "34", "35", "36", "37", "38", "39", "40", "41", "42", "43", "44", "45", "46", "47", "48", "49", "50", "51", "52", "53", "54", "55", "56", "57", "58", "59", "60", "61", "62", "63", "64", "65", "66", "67", "68", "69", "70", _
100, "101", "102", "103", "104", "105", "106", "107", "108", "109", "110", "200", "201", "202", "203", "204", "205", "240", "241", "242", "243", "244", "245"))
If Num_List = 1 Then
Application.AddCustomList ListArray:=Array("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15", "16", "17", "18", "19", "20", "21", "22", "23", "24", "25", "26", "27", "28", "29", "30", _
31, "32", "33", "34", "35", "36", "37", "38", "39", "40", "41", "42", "43", "44", "45", "46", "47", "48", "49", "50", "51", "52", "53", "54", "55", "56", "57", "58", "59", "60", "61", "62", "63", "64", "65", "66", "67", "68", "69", "70", _
100, "101", "102", "103", "104", "105", "106", "107", "108", "109", "110", "200", "201", "202", "203", "204", "205", "240", "241", "242", "243", "244", "245")
Num_List = Application.CustomListCount
End If
Feuil1.Range("A4:a600").Select
Selection.Sort Key:=Range("a4"), Order:=xlAscending, Header:=xlGuess, _
OrderCustom:=n, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End Sub


Dans l'attente merci

 

[david84]

Re : problème VBA Tri liste personnalise

Bonsoir,
à tester (supprimer les 1ères lignes de manière à avoir l'entête "Services" en A1) :

Sub trier()
Dim Pl As Range, i As Long
Application.ScreenUpdating = False
Set Pl = Range("A1").CurrentRegion
Columns(1).Insert
Range("A1").Resize(Pl.Rows.Count) = Pl.Value
For i = 2 To Pl.Rows.Count
If Cells(i, 1).Value <> Int(Cells(i, 1).Value) Then
  Cells(i, 1).Value = 1000000000 + Cells(i, 1).Value
End If
Next i
[A1].Sort key1:=[A1], Order1:=xlAscending, Header:=xlGuess
Columns(1).Delete Shift:=xlToLeft
Application.ScreenUpdating = True
End Sub

A+

 

[fred94000]

Re : problème VBA Tri liste personnalise

bonsoir david84 et le forum,

bug sur la ligne en rouge

Sub tri()
Dim Pl As Range, i As Long
Application.ScreenUpdating = False
Set Pl = Range("A1").CurrentRegion
Columns(1).Insert
Range("A1").Resize(Pl.Rows.Count) = Pl.Value
For i = 2 To Pl.Rows.Count
If Cells(i, 1).Value <> Int(Cells(i, 1).Value) Then
Cells(i, 1).Value = 1000000000 + Cells(i, 1).Value
End If
Next i
[A1].Sort key1:=[A1], Order1:=xlAscending, Header:=xlGuess
Columns(1).Delete Shift:=xlToLeft
Application.ScreenUpdating = True
End Sub

merci d'avoir regardé mon post

 

[Staple1600]

Re : problème VBA Tri liste personnalise

Bonsoir à tous


Juste pour signaler que le code de david84 ne bug pas chez moi.
(W7+ Excel 2013)
Et j'ai bien sur respecter les consignes de david avant de tester.

à tester (supprimer les 1ères lignes de manière à avoir l'entête "Services" en A1

 

[fred94000]

Re : problème VBA Tri liste personnalise

bonsoir staple1600, david84 et le forum,
effectivement après modif, cela fonctionne mais une erreur dans la fin du tri cellule A45
je vous joins le fichier vous n'avez qu'a cliquez sur le bouton.
merci encore

 

[Staple1600]

Re : problème VBA Tri liste personnalise

Re

Non il n'y a pas d'erreur si on traite la colonne A, sans modifier la macro de david
On commence à la ligne 2 (pas à la ligne 5)
Puisque comme déjà signalé!
supprimer les 1ères lignes de manière à avoir l'entête "Services" en A1
Sub tri()
Dim Pl As Range, i As Long
Application.ScreenUpdating = False
Set Pl = Range("A1").CurrentRegion
Columns(1).Insert
Range("A1").Resize(Pl.Rows.Count) = Pl.Value
For i = 2 To Pl.Rows.Count
If Cells(i, 1).Value <> Int(Cells(i, 1).Value) Then
Cells(i, 1).Value = 1000000000 + Cells(i, 1).Value
End If
Next i
[A1].Sort key1:=[A4], Order1:=xlAscending, Header:=xlGuess
Columns(1).Delete Shift:=xlToLeft
Application.ScreenUpdating = True
End Sub

 

[fred94000]

Re : problème VBA Tri liste personnalise

Re staple1600, David84
bien compris exécution impeccable, donc il m'est impossible de rajouter des lignes en début de tableau?
fonctionne très bien.

grand MERCI à vous deux

 

[Staple1600]

Re : problème VBA Tri liste personnalise

Re

Si. C'est possible.
Le plus simple serait d'ajouter les lignes après avoir exécuter la macro de tri.
ou alors il faut écrire la macro autrement (utiliser une autre syntaxe que CurrentRegion)

 

[david84]

Re : problème VBA Tri liste personnalise

Bonjour à tous,

donc il m'est impossible de rajouter des lignes en début de tableau?

si mais après il suffit d'adapter, par exemple :

Sub tri()
Dim Pl As Range, i As Long
Application.ScreenUpdating = False
Set Pl = Range("A4").CurrentRegion
Columns(1).Insert
Columns(2).Copy Columns(1)
For i = 2 To Pl.Rows.Count
If Pl(i).Value <> Int(Pl(i).Value) Then
  Pl(i).Value = 1000000000 + Pl(i).Value
End If
Next i
[B4].Sort key1:=[B4], Order1:=xlAscending, Header:=xlGuess
Columns(2).Delete Shift:=xlToLeft
Application.ScreenUpdating = True
End Sub

Il y a bien sûr d'autres possibilités comme celui de passer par deux Arrays (un pour les nombres entiers l'autre pour les nombres décimaux que l'on triera séparément et que l'on replacera ensuite dans la feuille). Traitement sûrement plus rapide sur des données importantes mais plus difficile à comprendre si tu n'es pas familiarisé avec le VBA.
A+