"Scanner" une liste / extraire le nbre d'élem diff

Option Explicit

Sub Allotement_Calculation()
Dim Plage As Range
Dim Cell As Range
Dim Destination As String
Dim Luggage As Integer


With Sheets('Feuil2')
Set Plage = .Range(.Range('A2'), .Range('A65536').End(xlUp))
End With

For Each Cell In Plage

        If Len(Cell) >= 64 Then
            Destination = Mid(Cell, 47, 3)
            Luggage = Val(Mid(Cell, 53, 3))
            Cell.Offset(0, 3) = Destination
            Cell.Offset(0, 6) = Luggage
        End If
               
Next Cell
       
End Sub

Cliquez pour agrandir...

Sub Calculation_Per_Destination()
Dim TabPlage As Variant
Dim Cell As Range
Dim ColDestination As Collection
Dim ItemDestination As Variant
Dim CountLuggage As Integer
Dim Ligne As Integer, I As Integer


Ligne = 9

With Sheets('Feuil2')
    TabPlage = .Range(.Range('D2'), .Range('G65536').End(xlUp))
End With


Set ColDestination = New Collection

    For I = 1 To UBound(TabPlage)
        If Len(TabPlage(I, 1)) = 3 Then
            On Error Resume Next
                ColDestination.Add CStr(TabPlage(I, 1)), CStr(TabPlage(I, 1))
            On Error GoTo 0
        End If
    Next
   
    For Each ItemDestination In ColDestination
                        For I = 1 To UBound(TabPlage)
                              If ItemDestination = TabPlage(I, 1) Then
                                  CountLuggage = CountLuggage + Val(TabPlage(I, 4))
                                End If
                        Next
                With Sheets('Feuil2')
                    .Cells(Ligne, 9) = ItemDestination
                    .Cells(Ligne, 10) = CountLuggage
                End With
        CountLuggage = 0
        Ligne = Ligne + 1
    Next ItemDestination

End Sub

Cliquez pour agrandir...

Option Explicit

Sub Allotement_Calculation()
Dim Plage As Range
Dim Cell As Range
Dim Destination As String
Dim Luggage As Integer


With Sheets('Feuil2')
Set Plage = .Range(.Range('A2'), .Range('A65536').End(xlUp))
End With

For Each Cell In Plage

        If Len(Cell) >= 64 Then
            Destination = Mid(Cell, 47, 3)
            Luggage = Val(Mid(Cell, 53, 3))
            Cell.Offset(0, 3) = Destination
            Cell.Offset(0, 6) = Luggage
        End If
               
Next Cell
       
Calculation_Per_Destination '<<< ICI !
End Sub


Sub Calculation_Per_Destination()
Dim TabPlage As Variant
Dim Cell As Range
Dim ColDestination As Collection
Dim ItemDestination As Variant
Dim CountLuggage As Integer
Dim Ligne As Integer, I As Integer


Ligne = 9

With Sheets('Feuil2')
    TabPlage = .Range(.Range('D2'), .Range('G65536').End(xlUp))
End With


Set ColDestination = New Collection

    For I = 1 To UBound(TabPlage)
        If Len(TabPlage(I, 1)) = 3 Then
            On Error Resume Next
                ColDestination.Add CStr(TabPlage(I, 1)), CStr(TabPlage(I, 1))
            On Error GoTo 0
        End If
    Next
   
    For Each ItemDestination In ColDestination
                        For I = 1 To UBound(TabPlage)
                              If ItemDestination = TabPlage(I, 1) Then
                                  CountLuggage = CountLuggage + Val(TabPlage(I, 4))
                                End If
                        Next
                With Sheets('Feuil2')
                    .Cells(Ligne, 9) = ItemDestination
                    .Cells(Ligne, 10) = CountLuggage
                End With
        CountLuggage = 0
        Ligne = Ligne + 1
    Next ItemDestination

End Sub

Cliquez pour agrandir...