Affichage Contact feuil2 via MsgBox par clic cellule feuil1 Le sujet est résolu

Y compris Power BI, Power Query et toute autre question en lien avec Excel
B
BenjiBYC
Nouveau venu
Nouveau venu
Messages : 3
Inscrit le : 10 septembre 2019
Version d'Excel : 2013

Message par BenjiBYC » 10 septembre 2019, 15:06

Bonjour à tous,

J'ai un fichier simple, mais je bloque depuis plusieurs jour sur l'écriture d'une procédure.

Contexte :
J'ai un ficher Excel avec 2 onglets.
L'onglet 1 "Synthèse" regroupe une liste d'entreprise. Chaque ligne est unique (une entreprise différente par ligne)
L'onglet 2 "contact" regroupe les contacts recensés pour chaque entreprise. Selon les entreprises, je peux avoir plusieurs contacts (donc plusieurs lignes).

L'objectif :
Lorsque je suis en onglet 1 "synthèse",
si je clic sur la cellule contenant le nom de l'entreprise (colonne B),
un msgbox s'ouvre et affiche les contacts associés à l'entreprise.

Exemple :
Si je clic sur la cellule B3 onglet "Synthèse", alors un msgbox m'affiche les infos des cellules A4 à K6 de l'onglet "contact" sous format d'un tableau, ce dernier reprenant l'entête en ligne 1 de l'onglet "contact".

Merci pour votre aide !

En pj un fichier exemple :
Test MsgBox.xlsm
(25.44 Kio) Téléchargé 4 fois
Avatar du membre
i20100
Passionné d'Excel
Passionné d'Excel
Messages : 5'714
Appréciations reçues : 333
Inscrit le : 16 mars 2017
Version d'Excel : 2010

Message par i20100 » 11 septembre 2019, 00:05

Bonjour BenjiBYC et bienvenue,
:bv:

à tester,
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Target.Column = 2 Then
 If Target = "" Then Exit Sub
 ligne = Application.Match(Target, Sheets("Contact").Range("C:C"), 0)
 nb = Application.CountIf(Sheets("Contact").Range("C:C"), Target)
 
 For j = 1 To nb
    For i = 4 To Sheets("Contact").Cells(ligne, Columns.Count).End(xlToLeft).Column
      t = t & Chr(10) & Sheets("Contact").Cells(ligne, i).Value
    Next i
    
    t = t & Chr(10)
 Next j
 MsgBox t
End If
End Sub
Vive ces nouvelles saisons qui nous colorent.
isabelle
B
BenjiBYC
Nouveau venu
Nouveau venu
Messages : 3
Inscrit le : 10 septembre 2019
Version d'Excel : 2013

Message par BenjiBYC » 11 septembre 2019, 09:45

Bonjour i20100,

Merci pour l'accueil, et merci pour ton code !

C'est effectivement le rendu dont j'espérai.
Mais cela affiche le même contact x le nombre de ligne de contact.

Pour bien comprendre les itérations de ton code,
i = aux valeurs à reprendre dans "contact"
j = itération pour le nombre de contact à afficher
t = affichage dans msgbox avec saut de ligne via Chr(10)

Du coup faut-il ajouter une itération complémentaire pour afficher chaque ligne ayant le même nom d'entreprise dans l'onglet "contact" pour obtenir tous les contacts différents ?

Egalement, pour bien comprendre, quelle est la finalité du Countif ici ?

Encore merci
g
gmb
Fanatique d'Excel
Fanatique d'Excel
Messages : 12'832
Appréciations reçues : 362
Inscrit le : 4 avril 2013
Version d'Excel : 2016

Message par gmb » 11 septembre 2019, 12:56

Bonjour
Bounjour à tous

Nouvelle version obtenue en modifiant un peu le code de 20100 :
Bye !
Test MsgBox v2.xlsm
(36.16 Kio) Téléchargé 3 fois
B
BenjiBYC
Nouveau venu
Nouveau venu
Messages : 3
Inscrit le : 10 septembre 2019
Version d'Excel : 2013

Message par BenjiBYC » 11 septembre 2019, 13:46

Up,

Finalement, j'ai réussi à trouver un palliatif à l'itération.

Voici le code de i20100 corrigé pour le bon fonctionnement de la macro :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Target.Column = 2 Then
If IsEmpty(Target) Then Exit Sub
ligne = Application.Match(Target, Sheets("Contact").Range("C:C"), 0)
nb = Application.CountIf(Sheets("Contact").Range("C:C"), Target)
For j = 1 To nb
For i = 5 To Sheets("Contact").Cells(ligne, Columns.Count).End(xlToLeft).Column
t = t & Chr(10) & Sheets("Contact").Cells(ligne, i).Value
Next i
t = t & Chr(10)
ligne = ligne + 1
Next j
MsgBox t
End If
End Sub

Encore merci à vous :)
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message