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

[Guigui]

hello à tous...

j'ai une liste de donnée, je souhaite en extraire le nombre d'élément different ... multiplié par un nombre :

ex :
Liste:

AAA 2
BBB 1
AAA 1
CCC 1
BBB 2
resultat : AAA :3 BBB:3 CCC:1

Je copie/colle une liste d'un programme de reservation de vol, et ai besoin de savoir combien de bagages pour chaque destination sont prévus.
Faudrai que le prog 'scanne' la liste pour extraire les destination differente et ensuite utiliser le nbre de bagages par passager pour me dire : pour tel destination, tant de bagages...

Je vous joint un exemple pour mieux comprendre

Merci d'avance pour votre aide.
A+
Guillaume [file name=ALLOTEMENT_20060110114028.zip size=5349]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/ALLOTEMENT_20060110114028.zip[/file]

 

[_Thierry]

Bonjour Guillaume, le Forum

Voici une approche 100% VBA déjà pour extraire et isoler tes Destinations et tes quantités de baggageS

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

Testé même avec Centaine de bagages (Max)

Bon Appétit
[ol]@+Thierry[/ol]

 

[_Thierry]

Re Bonjour à tous

Tiens dans la foulée la suite pour écrire aussi ton tableau 'DESTINATION |NBRE TTL'

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

Re bon appétit

@+Thierry


PS Rien n'empêche de lancer la Procédure 'Calculation_Per_Destination' depuis la Procédure 'Allotement_Calculation' comme ceci :

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

Bye Bye