Comment faire correspondre un code postal à une ville automatiquement?

Le 18/04/2020 à 11:44

Bonjour,

Pour une base de donnée, comment puis-je procéder pour afficher le CP et sa ville correspondante? J'ai essayé la Recherche v en vain

Merci d'avance

44proposition-organisation.xlsx (32.35 Ko)
Le 18/04/2020 à 12:40

Bonjour Fredo, bonjour le forum,

Si tu dois faire correspondre la ville avec le code postal (le plus logique), le code postal devrait se trouver devant la ville dans le tableau, il me semble...

J'ai donc déplacé dans l'onglet BDD la colonne Code postal pour la mettre à gauche de la colonne Ville.

Rajoute le code ci-dessous dans le composant VBA Feuil3 (BDD) :

Private Sub Worksheet_Change(ByVal Target As Range) 'au changement dans l'onglet
Dim OC As Worksheet 'déclare la variable OC (Onglet des Codes)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)
Dim I As Integer 'déclare la variable I (Incrément)
Dim K As Integer 'déclare la variable K (incrément)
Dim L As String 'déclare la variable L (Liste)

'si le changement a lieu ailleurs que dans la colonne [Code postal], sort de la procédure
If Application.Intersect(Range("Tableau1[Code postal]"), Target) Is Nothing Then Exit Sub
'si la cellule est effacée, efface aussi la cellule en colonne [Ville], sort de la procédure
If Target.Value = "" Then Target.Offset(0, 1).Value = "": Exit Sub
Set OC = Worksheets("bdd Villes") 'définit l'onglet des codes OC
TV = OC.Range("Tableau4") 'définit le tableau des valeurs TV
For I = 1 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV
    If TV(I, 1) = Target.Value Then 'condition : si le code de la boucle est égal au code de la cellule modifiée
        ReDim Preserve TL(K) 'redimensoionne le tableau des lignes TL
        TL(K) = TV(I, 2) 'récupère la ville dans la ligne K du tableau des lignes
        K = K + 1 'incrémente K
    End If 'fin de la condition
Next I 'prochaine ligne de la boucle

If K = 0 Then 'condition : si K = 0 (le code n'existe pas)
    Application.EnableEvents = True 'interdit les événementielles (pour éviter la boucle sur l'événement Change)
    MsgBox "Code inexistant ! Veuillez recommancer." 'message
    Target.ClearContents 'efface le contenu de la cellule (relance l'événementielle Change)
    Application.EnableEvents = True 'autorise ls événementielles
    Target.Select 'sélectionne la cellule
    Exit Sub 'sort de la procédure
End If 'fin de la condition

If UBound(TL) = 0 Then 'si TL ne contient qu'une seule ville
    Target.Offset(0, 1).Value = TL(0) 'renvoie la ville dans la cellule adjacente, colonne [Ville]
Else 'sinon
    L = Join(TL, ",") 'définit la liste L
    With Target.Offset(0, 1).Validation 'prend en compte la validation de donnée de la cellule ajacente en colonne [Ville]
        .Delete 'efface une éventuelle validation de données
        .Add xlValidateList, Formula1:=L 'ajoute la liste L comme liste de validation de données
    End With 'fin de la prise en compte de la validation de donnée de la cellule ajacente en colonne [Ville]
End If 'fin de la condition
Target.Offset(0, 1).Select 'sélection la cellule adjacente en colonne [Ville]
End Sub

Désormais quand tu tapes un code, soit il ne correspond qu'à une seule ville et elle s'affiche, soit la liste des villes correspondant au code s'affiche et il ne te reste plus qu'à la sélectionner dans la liste...

Le 18/04/2020 à 13:28

Bonjour Thau Thème,

Oui j'ai changé les colonnes et toujours pas réussi à le faire.

Merci de votre aide

Bonne après-midi

Fred

Le 18/04/2020 à 13:30

Re,

Je viens de rééditer mon premier post avec la réponse...

Le 18/04/2020 à 13:35

Re,

Ooops il pouvait y avoir un beug...

le code corrigé :

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range) 'au changement dans l'onglet
Dim OC As Worksheet 'déclare la variable OC (Onglet des Codes)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)
Dim I As Integer 'déclare la variable I (Incrément)
Dim K As Integer 'déclare la variable K (incrément)
Dim L As String 'déclare la variable L (Liste)

'si le changement a lieu ailleurs que dans la colonne [Code postal], sort de la procédure
If Application.Intersect(Range("Tableau1[Code postal]"), Target) Is Nothing Then Exit Sub
'si la cellule est effacée, efface aussi la cellule en colonne [Ville], sort de la procédure
If Target.Value = "" Then Target.Offset(0, 1).Clear : Exit Sub
Set OC = Worksheets("bdd Villes") 'définit l'onglet des codes OC
TV = OC.Range("Tableau4") 'définit le tableau des valeurs TV
For I = 1 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV
    If TV(I, 1) = Target.Value Then 'condition : si le code de la boucle est égal au code de la cellule modifiée
        ReDim Preserve TL(K) 'redimensoionne le tableau des lignes TL
        TL(K) = TV(I, 2) 'récupère la ville dans la ligne K du tableau des lignes
        K = K + 1 'incrémente K
    End If 'fin de la condition
Next I 'prochaine ligne de la boucle

If K = 0 Then 'condition : si K = 0 (le code n'existe pas)
    Application.EnableEvents = True 'interdit les événementielles (pour éviter la boucle sur l'événement Change)
    MsgBox "Code inexistant ! Veuillez recommencer." 'message
    Target.ClearContents 'efface le contenu de la cellule (relance l'événementielle Change)
    Application.EnableEvents = True 'autorise ls événementielles
    Target.Select 'sélectionne la cellule
    Exit Sub 'sort de la procédure
End If 'fin de la condition

If UBound(TL) = 0 Then 'si TL ne contient qu'une seule ville
    Target.Offset(0, 1).Validation.Delete 'efface une éventuelle validation de donnée dans la cellule adjacente colonne [Ville]
    Target.Offset(0, 1).Value = TL(0) 'renvoie la ville dans la cellule adjacente, colonne [Ville]
Else 'sinon
    L = Join(TL, ",") 'définit la liste L
    With Target.Offset(0, 1).Validation 'prend en compte la validation de donnée de la cellule ajacente en colonne [Ville]
        .Delete 'efface une éventuelle validation de données
        .Add xlValidateList, Formula1:=L 'ajoute la liste L comme liste de validation de données
    End With 'fin de la prise en compte de la validation de donnée de la cellule ajacente en colonne [Ville]
End If 'fin de la condition
Target.Offset(0, 1).Select 'sélection la cellule adjacente en colonne [Ville]
End Sub
Rechercher des sujets similaires à "comment correspondre code postal ville automatiquement"