Carte de france

[bloublou]

Bonjour à tous,

J'avais trouvé cette carte de france sur le forum, après avoir lu pas mal de fils.
Merci à ceux qu'ils l'ont developpé pour avoir fait cet énorme travail 🙂

J'ai essayé de commenter le code mais je ne comprends pas tous les enchevêtrements.
Est-ce que quelqu'un peut m'aider à y voir plus clair ? 😕

Egalement le but de la compréhension du code, serait de pouvoir le modifier pour arriver à mettre sur le côté de la carte de france (CF) les informations de la feuille liste :

Exemple :

je clique sur le dpt des bouches du rhône j'obtiens les 3 noms de ma liste.

Est-ce que quelqu'un peut m'aider pour cette demande ?

Merci

BlouBlou

 

[JCGL]

Re : Carte de france

Bonjour à tous,

Un essai en attachement.
Il reste un problème dans les cas où plusieurs noms sont dans le même département : j'ai bien les valeurs mais toujours la première...

A + à tous

 

[Efgé]

Re : Carte de france

Bonsoir bloublou, Salut JC 🙂
Ma pierre à l'édifice

=SI(LIGNES($1:1)<=NB.SI(Liste!$G$2:$G$8;$P$1);INDEX(Liste!$B$2:$G$8;(EQUIV($P$1;Liste!$G$2:$G$8;0)-1)+LIGNES($1:1);COLONNES($A:A));"")

A tirer de K15 à P22 ou plus si affinités 😀.
J'ai déplacé ce qui s'inscrit en P15 vers la cellule P1 pour garder la cohérence de la formule.
Je suis bien certain qu'il y a mieux.
Cordialement

 

[JCGL]

Re : Carte de france

Bonjour à tous,
Salut FG,

Joli l'ami...

A++
A + à tous

 

[phlaurent55]

Re : Carte de france

Bonjour bloublou,
Salut Jean-Claude, Efgé,

une autre pierre à l'édifice

à+
Philippe

Edit: Nouvelle version avec une petite correction

 

[JCGL]

Re : Carte de france

Bonjour à tous,
Salut FG,

Joli l'ami...

A++
A + à tous

 

[Modeste geedee]

Re : Carte de france

Bonsour®

Bonjour bloublou,
Salut Jean-Claude, Efgé,

une autre pierre à l'édifice

🙄 une autre pierre...
Full VBA

 

[bloublou]

Re : Carte de france

Bonjour JCGL, Efgé, phlaurent55, et Modeste geedee,

Merci à tous pour ces solutions.

Effectivement JCGL l'index equiv mais le pb il prend que le 1er resultat trouvé 🙁 🙁 🙁 Mais c vrai que je n'ai pas pensé à l'appliquer comme premiere solution à notre cas 🙂


Par contre Efgé, je n'ai pas réussi à ouvrir ton fichier, un contenu illisible, il a pas aimé :-(

Phlaurent55, je ne comprends pas l'utilisation de la formule ligne()-14.

Modeste Geedee est-ce que tu peux m'expliquer un petit plus sur ton code ? que je comprenne bien toute la logique.

En tout cas merci à tous pour tes solutions 🙂 🙂 🙂

BlouBlou

 

[Modeste geedee]

Re : Carte de france

Bonsour®

Modeste Geedee est-ce que tu peux m'expliquer un petit plus sur ton code ? que je comprenne bien toute la logique.

[Highlight=VB]
Sub Macro1()
Dim noDpt As Integer, Ligne As Integer, Colonne As Integer
Dim c As Range, FirstAddress As String
' ---------------------------------récuperation du N°dept issu de la selection
' ---------------------------------voir module de feuille Sht_Fra : Sub Cbx_Dpt_Click()
noDpt = [q14]
' ---------------------------------blocage rafraichissement écran(clignotement)
Application.ScreenUpdating = False
' -------------------------------- effacement de la palge de réception
Sheets("France").[K15:q45].ClearContents
' -------------------------------- la source est la plage de de données de la feuille liste
With Worksheets("liste").Range("a1:a100")
' --------------------------------code adapté de l'aide en ligne
' -------ms-help://MS.EXCEL.DEV.12.1036/EXCEL.DEV/content/HV10062997.htm
' --------------------------------recherche NoDpt dans valeurs, cellule complete
Set c = .Find(noDpt, LookIn:=xlValues, lookat:=xlWhole)
' --------------------------------correspondance trouvée
If Not c Is Nothing Then
'--------------------------------- initialisation ligne cible
Ligne = 15
' --------------------------------première adresse trouvée
FirstAddress = c.Address
' -------------------------------- bouclage sur les colonnes pour récuperer les données
Do
For Colonne = 1 To 6 ' ---il y a 6 colonnes de données
' ----------------------- ecriture cible décaleé de 10 colonnes / à la colonne lue
Sheets("France").Cells(Ligne, Colonne + 10) = c.Offset(0, Colonne)
Next
' ----------------------- ecriture NoDpt pour rappel
Sheets("France").Cells(Ligne, 17) = noDpt
' -------------------------recherche suivante
Ligne = Ligne + 1 ' -- prépositionnement ligne cible suivante
' -------------------------rechercheche suivante selon parametre Find initial
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> FirstAddress
' --------------------------sortie de recherche si adresse trouvée identique à premiere
End If
End With
' -------------------------réactivation rafraichissement écran
Application.ScreenUpdating = True
End Sub

[/code]

 

[bloublou]

Re : Carte de france

Bonjour Modeste Geedee,

Merci pour ton info sur l'aide en ligne.
Mais j'ai du mal à comprendre cette ligne même dans l'exemple :

With Worksheets(1).Range("a1:a500")
Set c = .Find(2, lookin:=xlValues)
If Not c Is Nothing Then => Si c'est c est différent de rien ? parce que la methode Find renvoie nothing ?
firstAddress = c.Address
Do
c.Value = 5
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress => Boucle jusqu'à ce que c est à rien Et l'adresse de C est différent de first adresse
End If
End With

Merci beaucoup

BlouBlou

 

[Modeste geedee]

Re : Carte de france

Bonsour®

Bonjour Modeste Geedee,

Merci pour ton info sur l'aide en ligne.
Mais j'ai du mal à comprendre cette ligne même dans l'exemple :

With Worksheets(1).Range("a1:a500")
Set c = .Find(2, lookin:=xlValues)
If Not c Is Nothing Then => Si c'est c est différent de rien ? parce que la methode Find renvoie nothing ?

Cette méthode renvoie Nothing si aucune correspondance n'est trouvée.
La méthode Find n'affecte pas la sélection ni la cellule active.
c'est l'équivalent mathématique de l'ensemble Vide (rien, Nada...)

firstAddress = c.Address
Do
c.Value = 5
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress => Boucle jusqu'à ce que c est à rien Et l'adresse de C est différent de first adresse
End If
End With

il faut traduire :
Loop tant que (pas Nothing ET adresse <> 1ere adresse)
ou encore
Loop tant que l'on trouve une adresse différente de la première

Lorsque la recherche atteint la fin de la plage de recherche spécifiée, elle
revient au début de cette plage. Pour arrêter une recherche lorsqu'elle revient
au point de départ, enregistrez l'adresse de la première cellule trouvée, puis
comparez l'adresse de chaque cellule ultérieurement trouvée avec l'adresse
enregistrée.

 

[bloublou]

Re : Carte de france

Bonjour Modeste Geedee,

Merci pour toutes ces explications 🙂 🙂

Encore une derniere chose, le :

Set c = .Find(2, lookin:=xlValues)
Set => initialise la variable c ? à la place de c (plage de cellule) c'est la recherche du chiffre 2 ?

Merci

BlouBlou

 

[Modeste geedee]

Re : Carte de france

Bonsour®
c'est vrai que l'exemple Microsoft n'est pas didactiquement trés cohérent

il aurait fallut ecrire :
Set c = .Find(What:=2, lookin:=xlValues, MatchCase:=true, lookat:=xlwhole)
paramétres expréssement nommés (à privilégier !!!)

cela est autorisé ici car le parametre What est le premier à fournir et dans le cas présent le nom de l'argument peut etre omis,
les parametres étant nommés l'ordre est alors sans incidence.

ce n'est pas le cas des parametres suivants qui doivent expréssement etre nommés si chacun n'est pas documenté, les arguments étant chacuns facultatifs.

Function Find(What, [After], [LookIn], [LookAt], [SearchOrder], [SearchDirection As XlSearchDirection = xlNext], [MatchCase], [MatchByte], [SearchFormat])

set c =.find(2, , xlvalue, xlwhole, , , true)
parametres non nommés, ils doivent etre dans l'ordre !!

la formulation équivalente ci-dessous est à éviter !!! #?!¿
set c =.find(2, , -4163, 1, , , -1)

 

[bloublou]

Re : Carte de france

Bonsour Modeste Geedee,

Merci pour toutes ces infos et pour ton code 🙂

BlouBlou

 

[Si...]

Re : Carte de france

salut

tu pouvais passer par une simple boucle :

Sub Macro1()
  Dim noDpt As Integer, Ligne As Integer, Colonne As Integer
  Dim c As Range, a As String
  noDpt = [q14]
  Application.ScreenUpdating = False
  With Sheets("France")
    .[K15:q45].ClearContents
    Ligne = 15
    For Each c In Worksheets("Liste").Range("A1:A100")
      If c = noDpt Then
        For Colonne = 1 To 6
          .Cells(Ligne, Colonne + 10) = c.Offset(, Colonne)
        Next
        .Cells(Ligne, 17) = noDpt
        Ligne = Ligne + 1
      End If
    Next
  End With
End Sub