XL 2019 Classement onglets

[litelsousa]

Bonjour,
Je n'arrive pas à classer mes feuilles selon le principe suivant (elles sont déjà nommées directement selon la valeur d'une cellule):

PK 0.125 +
PK 1.25 +
PK 1.25 -
PK 10.258 -
Pk 13.450 +
Pk 13.450 -
Pk 123.450 -

J'aimerais que ce classement soit établi selon:
1° le PK
2° les "+" et "-".
J'ai trouvé divers code, celui-ci est celui qui s'applique le mieux à mon cas

Sub Tri_onglet()
  Application.ScreenUpdating = False
  Dim a(256)
  n = Sheets.Count
  For i = 1 To n
     a(i) = Sheets(i).Name
  Next i
  '----  tri
  For i = 1 To n
     For j = i To n
        If a(j) < a(i) Then
          temp = a(j)
          a(j) = a(i)
          a(i) = temp
        End If
     Next j
  Next i
  '---
  For i = 1 To n
     Sheets(a(i)).Move before:=Sheets(i)
  Next i

End Sub

mais lorsqu'il y a du texte devant les chiffre, ça repasse en classement PK 2 - PK 20 - PK 3...



Je vous remercie pour votre aide.

 

[pierrejean]

Sub Tri_onglet()
  Application.ScreenUpdating = False
  Dim a(256)
  n = Sheets.Count
  For i = 1 To n
     a(i) = Sheets(i).Name
  Next i
  '----  tri
  For i = 1 To n
     For j = i To n
        If Replace(Replace(Replace(Replace(a(j), ".", ","), "PK", ""), "+", 1), "-", 0) * 1 < Replace(Replace(Replace(Replace(a(i), ".", ","), "PK", ""), "+", 1), "-", 0) * 1 Then
          Temp = a(j)
          a(j) = a(i)
          a(i) = Temp
        End If
     Next j
  Next i
  '---
  For i = 1 To n
     Sheets(a(i)).Move before:=Sheets(i)
  Next i

End Sub

modifié pour le fun

 

[litelsousa]

Bonjour,
Merci, mais mon soucis reste:
Pour les décimales c'est nickel, mais pour les unités, le PK 10 vient toujours avant le PK 2.

 

[kiki29]

Salut, une recherche ?

 

[dysorthographie]

Bonjour,

Function NumToString(V) As String
Dim N As String
For i = 1 To Len(V)
    If IsNumeric(Mid(V, i, 1)) Then
        N = N & Mid(V, i, 1)
    Else
        If N <> "" Then
            NumToString = NumToString & Format(N, String(13, "0"))
            N = ""
        End If
       NumToString = NumToString & Mid(V, i, 1)
    End If

Next
If N <> "" Then
        NumToString = NumToString & Format(N, String(13, "0"))
    End If
End Function
Sub test()
With ThisWorkbook
    For i = 2 To .Sheets.Count
        If NumToString(.Sheets(i).Name) < NumToString(.Sheets(i - 1).Name) Then
        .Sheets(i).Move Before:=.Sheets(i - 1)
         i = i - 2
        End If
        If i < 1 Then i = 1
    Next
End With
End Sub

 

[litelsousa]

Eh bien merci, ça marche nickel

 

[litelsousa]

A non pardon,
la feuille PK 10.4 vient avant la PK 10.041.

Est-ce dû au nombre de décimales?

 

[litelsousa]

Salut, une recherche ?

J'ai vu les 3/4 de ces pages, mais le soucis reste toujours le même...

 

[dysorthographie]

j'ai corrigé!

Function NumToString(V) As String
Dim N As String
For i = 1 To Len(V)
    If Mid(V, i, 1) = "." And N <> "" And Not CBool(InStr(N, ".")) Then
        N = N & Mid(V, i, 1)
    Else
        If IsNumeric(Mid(V, i, 1)) Then
            N = N & Mid(V, i, 1)
        Else
            If N <> "" Then
                NumToString = NumToString & Format(Val(Replace(N, ",", ".")), String(13, "0") & "." & String(13, "0"))
                N = ""
            End If
            NumToString = NumToString & Mid(V, i, 1)
        End If
    End If
Next
If N <> "" Then
        NumToString = NumToString & Format(Val(Replace(N, ",", ".")), String(13, "0") & "." & String(13, "0"))
    End If
End Function
Sub test()
With ThisWorkbook
    For i = 2 To .Sheets.Count
        If NumToString(.Sheets(i).Name) < NumToString(.Sheets(i - 1).Name) Then
         .Sheets(i).Move Before:=.Sheets(i - 1)
         i = i - 2
        End If
        If i < 1 Then i = 1
    Next
End With
End Sub
Sub a()
Debug.Print NumToString("PK 10.4") < NumToString("PK 10.041.")
End Sub

 

[litelsousa]

C'est nickel, merci

 

[litelsousa]

Re,
Je me permets une autre question sur la même chose...

Sub Trier_GPS()

Dim WorkRng As Range
Dim WorkAddress As String
On Error Resume Next
xTitleId = "Classement des feuilles"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Selon quelle cellule classer les feuilles ?", xTitleId, WorkRng.Address, Type:=8)
WorkAddress = WorkRng.Address
Application.ScreenUpdating = False
For i = 1 To Application.Worksheets.Count
    For j = i To Application.Worksheets.Count
        If VBA.UCase(Application.Worksheets(j).Range(WorkAddress)) < VBA.UCase(Application.Worksheets(i).Range(WorkAddress)) Then
            Application.Worksheets(j).Move Before:=Application.Worksheets(i)
        End If
    Next
Next
Application.ScreenUpdating = True
End Sub

Avec ce code, je classe mes onglets en fonction de la valeur d'une cellule.
Mais il m'arrive le même soucis qu'avec celui d'avant, je ne trouve pas comment le modifier pour classer selon la valeur réelle de la cellule (le 2 avant le 10, etc).
A noter que là, les valeurs de la cellule sont uniquement des chiffres.

 

[dysorthographie]

il faut le résoudre avec la même méthode qu'avant!

Sub Trier_GPS()

Dim WorkRng As Range
Dim WorkAddress As String
On Error Resume Next
xTitleId = "Classement des feuilles"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Selon quelle cellule classer les feuilles ?", xTitleId, WorkRng.Address, Type:=8)
WorkAddress = WorkRng.Address
Application.ScreenUpdating = False
With ThisWorkbook
    For i = 2 To .Sheets.Count
        If NumToString(.Sheets(i).Range(WorkAddress)) < NumToString(.Sheets(i - 1).Range(WorkAddress)) Then
         .Sheets(i).Move Before:=.Sheets(i - 1)
         i = i - 2
        End If
        If i < 1 Then i = 1
    Next
End With

Application.ScreenUpdating = True
End Sub

tu noteras un petit détail dans le traitement!

un tri alphanumérique consiste à inverser 2 valeur? une fois qu'on a inversé le Z et le A on a plus besoin de vitrifier la A et le Z!

un tableau ne peut être à plus de 50% de désordre une double boucle for i,j fait toujours
(i * i) - i rotation soit 90 pour 10 valeurs!

ma méthode fait 9 rotation si les valeurs sont dans l'ordre et 45 si tout est en désordre!

 

[litelsousa]

OK, merci bien