Microsoft 365 Code VBA erreur dans le résultat

[luke3300]

Bonjour le forum,
Cela fait plusieurs jours que je cale sur un code que j'utilise pour générer un tri de données suivi d'un classement dans 3 colonnes différentes suivant l'importance du score dans ces données.
Je pensais que tout se faisait correctement mais en regardant de près, je m'aperçois que lorsque j'ai un total de 240 conducteurs dans ma feuille de départ "MR", il en reste +/-40 au total dans la feuille "Chauffeurs" qui doit comporter les résultats triés et répartis. Et il en manque dans les 3 colonnes.
Je ne comprends pas pourquoi ... quelqu'un pourrait m'aiguiller SVP?
J'ai ajouté une feuille dans le fichier Test avec le résultat recherché pour être plus clair.

Pour préciser, les données de la feuille "MR" sont toujours dans les cellules de B199 à C600.

Voici le code utilisé:

Sub Tri()
Application.ScreenUpdating = False
DerLig = Application.WorksheetFunction.CountA(Sheets("MR").Range("B199:B600"))
tablo = Sheets("MR").Range("B199:C" & DerLig)
DerLigTablo = UBound(tablo)
Sheets("Chauffeurs").Range("A5:H1000").ClearContents
I40 = 5: I30 = 5: I20 = 5
For i = 2 To DerLigTablo
    DPS = tablo(i, 2)
    If DPS > 40 Then
        Sheets("Chauffeurs").Range("B" & I40) = DPS
        Sheets("Chauffeurs").Range("A" & I40) = tablo(i, 1)
        I40 = I40 + 1
    ElseIf DPS <= 40 And DPS > 20 Then
        Sheets("Chauffeurs").Range("E" & I30) = DPS
        Sheets("Chauffeurs").Range("D" & I30) = tablo(i, 1)
        I30 = I30 + 1
    ElseIf DPS <= 20 Then
        Sheets("Chauffeurs").Range("H" & I20) = DPS
        Sheets("Chauffeurs").Range("G" & I20) = tablo(i, 1)
        I20 = I20 + 1
    End If
Next i
'PlusGrand

[A1].Select
End Sub


Sub PlusGrand()
Application.ScreenUpdating = False
    Range("A4:B600").Select
    ActiveWorkbook.Worksheets("Chauffeurs").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Chauffeurs").Sort.SortFields.Add Key:=Range("B5:B300") _
        , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Chauffeurs").Sort
        .SetRange Range("A4:B600")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("D4:E600").Select
    ActiveWorkbook.Worksheets("Chauffeurs").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Chauffeurs").Sort.SortFields.Add Key:=Range("E5:E300") _
        , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Chauffeurs").Sort
        .SetRange Range("D4:E600")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("G4:H600").Select
    ActiveWorkbook.Worksheets("Chauffeurs").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Chauffeurs").Sort.SortFields.Add Key:=Range("H5:H300") _
        , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Chauffeurs").Sort
        .SetRange Range("G4:H600")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Merci d'avance pour votre aide et belle journée.

 

[Hasco]

Bonjour,

Voici une autre façon de faire la chose, sans macro et avec powerquery (inclus dans votre version excel, onglet 'Données').

PowerQuery travaillant sur des tables de données, vos tableaux (source et destination )ont été transformés en tableaux structurés.

Par VBA, trier la source avant extraction, cela vous épargnera 2 tris.

Cordialement

 

[ChTi160]

Bonjour Luc3300
Bonjour Roblochon
voilà ce que j'ai modifié (dans la première procédure) et semble faire l'affaire(pas tout compris Lol)
pour déterminer la dernière ligne (DerLig) tu comptes le Nombre de valeurs (240) de la Plage (
B199:B600) ce qui ne correspond pas DerLig=439

Sub Tri()
Application.ScreenUpdating = False
With Sheets("MR") 'Ici
DerLig = .Cells(.Rows.Count, 2).End(xlUp).Row
End With
tablo = Sheets("MR").Range("B199:C" & DerLig)
DerLigTablo = UBound(tablo)
With Sheets("Chauffeurs")
          .Range("A5:H1000").ClearContents
I40 = 5: I30 = 5: I20 = 5
For i = 2 To DerLigTablo
    DPS = tablo(i, 2)
'j'ai inversé les if et ElseIf
   If DPS <= 20 Then
           .Range("H" & I20) = DPS
           .Range("G" & I20) = tablo(i, 1)
        I20 = I20 + 1    
          ElseIf DPS > 20 And DPS <= 40 Then    
           .Range("E" & I30) = DPS
           .Range("D" & I30) = tablo(i, 1)
        I30 = I30 + 1
          ElseIf DPS > 40 Then
           .Range("B" & I40) = DPS
           .Range("A" & I40) = tablo(i, 1)
        I40 = I40 + 1
    End If
Next i
'PlusGrand
[A1].Select
End With
End Sub

Et faire le Tri dans feuille MR avant procédures .
Bonne journée
jean marie

 

[luke3300]

Bonsoir Reblochon, Chti160, le forum,
Merci pour votre temps et vos solutions, je vais regarder cela et les tester.
Je vous donne des nouvelles ensuite 😉
Belle soirée à vous et encore merci.

 

[ChTi160]

Bonsoir Luke3300
Bonsoir le Fil ,le Forum
une autre approche

Sub Tri_2()
Application.ScreenUpdating = False
Dim ColCible As Byte
Dim DerLig As Integer
Dim DPS As Double
Sheets("Chauffeurs").Range("A5:H1000").ClearContents
With Sheets("MR")
DerLig = .Cells(.Rows.Count, 2).End(xlUp).Row 'Application.WorksheetFunction.CountA(Sheets("MR").Range("B199:B600"))
    With .Range("B199:C" & DerLig)
    .Sort key1:=.Cells(1, 2), Order1:=xlAscending, Header:=xlYes
    tablo = .Value
    End With
End With
With Sheets("Chauffeurs")
    For i = 2 To UBound(tablo)
        DPS = tablo(i, 2)        
            Select Case True
                      Case DPS <= 20
                                  ColCible = 7
            
                       Case DPS > 20 And DPS <= 40
                                  ColCible = 4
            
                       Case DPS > 40
                                  ColCible = 1
        
            End Select
      
      DerLig = .Cells(.Rows.Count, ColCible).End(xlUp).Row + 1
                     .Cells(DerLig, ColCible) = tablo(i, 1)
                     .Cells(DerLig, 1 + ColCible) = DPS
    Next i
[A1].Select
End With
Application.ScreenUpdating = True
End Sub

bonne soirée
jean marie

 

[luke3300]

Bonsoir Jean-Marie, le forum,

Merci pour vos solutions, ça marche impeccable.
Belle soirée à tous et encore merci.