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
|
Option Base 1
Public Cliste_ss_doublon As Collection
Sub H()
Dim Va As Variant
Dim Bville_trouvé As Boolean
Dim i As Integer, j As Integer, k As Integer
Dim Vlisting As Variant
Dim Ws As Worksheet
Dim Vposition_ville As Variant
Dim tab_recherche()
Dim Vadress_fin As Variant
Set Ws = Worksheets(1)
Set Cliste_ss_doublon = New Collection
Vadress_fin = Range("a1").End(xlDown).Offset(0, 1).Address
Vlisting = Range("a1:" & Vadress_fin) 'si A1 est la cellule de départ
On Error Resume Next
For i = 1 To UBound(Vlisting, 1)
Cliste_ss_doublon.Add Vlisting(i, 1), CStr(Vlisting(i, 1)) ' création d'une liste vide sans doublon
If Err.Number = 0 Then
j = j + 1
ReDim Preserve tab_recherche(j)
tab_recherche(j) = Vlisting(i, 1) & "pos" & i ' 1er apparition d' une ville sur le listing
End If
Err.Clear
Next
On Error GoTo 0
For Each Va In Cliste_ss_doublon
i = 0
k = 0
Bville_trouvé = False
'trouve la position de la ville dans le variant dans le but de ne pas boucler sur l 'ensemble du tableau
Do While i < UBound(tab_recherche, 1) And Bville_trouvé = False
i = i + 1
Vposition_ville = InStr(1, tab_recherche(i), Va)
If Vposition_ville > 0 Then
Bville_trouvé = True
Vposition_ville = Mid(tab_recherche(i), InStr(1, tab_recherche(i), "pos") + 3, Len(tab_recherche(i)) - (InStr(1, tab_recherche(i), "pos") + 2))
End If
Loop
For j = Vposition_ville To UBound(Vlisting, 1) ' compte le nb d ' occurence "ville"
If Va Like Vlisting(j, 1) Then
k = k + 1
Vlisting(j, 2) = k
End If
Next j
Next
Ws.Range("a1:" & Vadress_fin) = Vlisting
End Sub |
Partager