affect = der
Function Affect(Pays$, Liste As Range)
Dim T, i%, Ville$
T = Liste ' Transfert liste dans array ( plus rapide )
For i = 1 To UBound(T)
If T(i, 1) = Pays And T(i, 2) <> "" Then
Ville = T(i, 2)
End If
Next i
If Ville = "" Then ' Gestion réponse
Affect = "Pas de réponse" ' Rien trouvé
Else
Affect = Ville ' Sinon réponse ville
End If
End Function
Soyez un peu plus explicite. La liste entière de quoi ? des villes ?il me faut la liste entière de chaque pays
Ma fonction remonte la dernière ville trouvée du pays demandé.cela va afficher la dernière ville connue
Pour moi D était rempli.En fait je balaye la col A selon ma valeur en D
Sub Worksheet_Activate()
Dim DL%, N%, i%, Pays$, Ville$
Application.ScreenUpdating = False
[A:B].ClearContents
With Sheets("Feuil1")
DL = .Range("A65500").End(xlUp).Row
Range("A1:A" & DL) = .Range("A1:A" & DL).Value ' Copie colle liste pays
T = .Range("A1:B" & DL)
End With
ActiveSheet.Range("$A$1:$A$" & DL).RemoveDuplicates Columns:=1, Header:=xlNo ' Supprime doublon
DL = Range("A65500").End(xlUp).Row
For N = 1 To DL
Pays = Cells(N, "A"): Ville = ""
For i = 1 To UBound(T) ' Recherche dernière ville
If T(i, 1) = Pays And T(i, 2) <> "" Then
Ville = T(i, 2)
End If
Next i
If Ville <> "" Then Cells(N, "B") = Ville ' Affiche dernière ville
Next N
End Sub
Function Parcours(NoPays%, NoItem%)
' NoPays est le Nème pays à chercher, NoItem=1 pour pays, 2 pour ville
' On considère la liste dans la même feuille que la fonction
Dim DL%, IndexPays%, PaysTrouvé$, i%, T
Parcours = ""
Application.Volatile ' La fonction est recalculée à chaque modification de cellule
With ActiveSheet ' On transfert la liste dans un array pour aller plus vite
DL = .Range("A65500").End(xlUp).Row ' Dernière ligne de la liste
T = .Range("A1:B" & DL) ' Copie colle liste pays dans l'array T
End With
IndexPays = 0: PaysTrouvé = "" ' Init variables
For i = 1 To UBound(T) ' On parcourt le tableau
If T(i, 1) <> "" Then ' Si un pays est présent
If T(i, 1) <> PaysTrouvé Then ' et s'il est différent de celui mémorisé, donc c'est un nouveau
IndexPays = IndexPays + 1 ' On incrémente le N° de pays trouvé
PaysTrouvé = T(i, 1) ' On mémorise le nom du pays
If IndexPays = NoPays Then Exit For ' Si le N° de pays = N° demandé on sort
End If
End If
Next i
If NoItem = 1 And NoPays = IndexPays Then ' Si la fonction demande de remonter le pays
Parcours = PaysTrouvé ' On remonte l'info
Exit Function ' On sort de la fonction
End If
For i = UBound(T) To 1 Step -1 ' On arrive ici si on demande la ville
If NoPays > IndexPays Then Exit Function ' Si le N° demandé est > au max trouvé on sort
If T(i, 1) = PaysTrouvé And T(i, 2) <> "" And NoItem = 2 Then
Parcours = T(i, 2) ' On transfert la ville
Exit Function ' On sort de la fonction
End If
Next i
End Function