Autres ajouter des données correspondantes

P

PHV62

XLDnaute Junior
bonjour
j utilise Excel 2007
je voudrais rajouter les noms des enfants sur la même ligne a par rapport a la cellule de l époux
ci joint un fichier avec explication
merci d avance
phv62
 

Pièces jointes

  • Classeur1 TEST FORUM.xlsx
    9.9 KB · Affichages: 12
Trier par date Trier par votes
J

JHA

XLDnaute Barbatruc
Bonjour à tous,

Un essai à essayer en "E3" sous excel 2007 avec cette formule matricielle.
VB: 
=SIERREUR(SI(ESTNUM(EQUIV($D3;$B$3:$B$14;0));INDEX($A$3:$A$14;PETITE.VALEUR(SI($B$3:$B$14=$D3;LIGNE($B$3:$B$14)-2);COLONNES($A:A)));SI(ESTNUM(EQUIV($D3;$C$3:$C$14;0));INDEX($A$3:$A$14;PETITE.VALEUR(SI($C$3:$C$14=$D3;LIGNE($C$3:$C$14)-2);COLONNES($A:A)));""));"")
Valider par Ctrl+Maj+Entrée

JHA
 

Pièces jointes

  • Classeur1 TEST FORUM.xlsx
    11.5 KB · Affichages: 8
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bonjour PHV62, JHA,

Voyez le fichier joint et cette macro évènementielle dans le code de la feuille :
VB: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim P As Range, d As Object, tablo, i&, x$
Set P = Intersect(Range("D3:E" & Rows.Count), UsedRange)
If P Is Nothing Then Exit Sub
Set d = CreateObject("Scripting.Dictionary")
tablo = [A2].CurrentRegion.Resize(, 3) 'matrice, plus rapide
For i = 2 To UBound(tablo)
    x = tablo(i, 2)
    If x <> "" Then d(x) = d(x) & Chr(1) & tablo(i, 1)
    x = tablo(i, 3)
    If x <> "" Then d(x) = d(x) & Chr(1) & tablo(i, 1)
Next
tablo = P 'matrice, plus rapide
For i = 1 To UBound(tablo)
    x = tablo(i, 1)
    If d.exists(x) Then tablo(i, 2) = Mid(d(x), 2) Else tablo(i, 2) = ""
Next
'---restitution---
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
P.Resize(, Columns.Count - P.Column + 1).ClearContents 'RAZ
P = tablo
P.Columns(2).TextToColumns P.Columns(2), xlDelimited, Other:=True, OtherChar:=Chr(1) 'commande Convertir
Application.EnableEvents = True 'réactive les évènements
End Sub
Elle se déclenche quand on valide ou modifie une cellule quelconque.

A+
 

Pièces jointes

  • Classeur1 TEST FORUM(1).xlsm
    20.8 KB · Affichages: 14
Vote positif 0 Vote négatif
P

PHV62

XLDnaute Junior
JHA à dit:
Bonjour à tous,

Un essai à essayer en "E3" sous excel 2007 avec cette formule matricielle.
VB: 
=SIERREUR(SI(ESTNUM(EQUIV($D3;$B$3:$B$14;0));INDEX($A$3:$A$14;PETITE.VALEUR(SI($B$3:$B$14=$D3;LIGNE($B$3:$B$14)-2);COLONNES($A:A)));SI(ESTNUM(EQUIV($D3;$C$3:$C$14;0));INDEX($A$3:$A$14;PETITE.VALEUR(SI($C$3:$C$14=$D3;LIGNE($C$3:$C$14)-2);COLONNES($A:A)));""));"")
Valider par Ctrl+Maj+Entrée

JHA
Cliquez pour agrandir...
JHA bonjour j ai donc essaye le fichier comme je disais ca fonctionne mais j ai quelque soucis
j explique dans le fichier je peux mettre autant d enfant que je veux la j en ai mis 16 trs bien

par contre moi mon fichier n est pas implante comme ta version
ma premiere ligne et la ligne 6
le nom de l epoux et la colonne M
le premier enfant a la colonne Y

si je reste avec la ligne 3 cela fonctionne par contre quand je me met en ligne 6 la je perd les premiers nom d enfant ca ce decale vers la droite j ai joint le fichier pour comprendre il faut utiliser la feuille 2 et rajouter des ligne vierge au debut pour arriver a la ligne 6 la tu verra ce qui ce passe
merci d avance pour l aide
phv62
 

Pièces jointes

  • Classeur1 TEST FORUM2.xlsx
    24.3 KB · Affichages: 5
Vote positif 0 Vote négatif
J

JHA

XLDnaute Barbatruc
Bonjour à tous,

Si les données se trouvent en ligne 6, il faut mettre "-5" dans la formule au lieu de "-2"
J'ai ajouté une formule pour éviter de mettre des doublons dans le second tableau, ne sont pris en compte que les "1".
VB: 
=SIERREUR(SI(ESTNUM(EQUIV($M3;$C$6:$C$500;0));INDEX($A$6:$A$500;PETITE.VALEUR(SI(($C$6:$C$500=$M3)*($B$6:$B$500=1);LIGNE($C$6:$C$500)-5);COLONNES($A:A)));SI(ESTNUM(EQUIV($M3;$D$6:$D$500;0));INDEX($A$6:$A$500;PETITE.VALEUR(SI(($D$6:$D$500=$M3)*($B$6:$B$500=1);LIGNE($D$6:$D$500)-5);COLONNES($A:A)));""));"")

JHA
 

Pièces jointes

  • Classeur1 TEST FORUM2.xlsx
    28.1 KB · Affichages: 6
Vote positif 0 Vote négatif
P

PHV62

XLDnaute Junior
PHV62 à dit:
bonjour JHA je n ai pas utilise la dernière version envoyé je suis reste sur la précédente par contre pour la ligne 6 avec-5 ça ne marche pas je dois rester sur la ligne 3

j ai encore une question comment peut on transformer cette formule de Excel 365 en Excel 2007
=SIERREUR(TRANSPOSE(FILTRE($A$3:$A$20;($B$3:$B$20=B3)*($C$3:$C$20=C3)*($A$3:$A$20<>A3));"")

d avance merci
phv62
Cliquez pour agrandir...
 
Vote positif 0 Vote négatif
P

PHV62

XLDnaute Junior
JHA à dit:
Bonjour à tous,

Peux-tu mettre le fichier qui te pose problème?
la formule index proposée devrait te donner le bon résultat.

JHA
Cliquez pour agrandir...
bonjour jha
désolée pour le retard de réponse
donc la formule du message précèdent et avec Excel 365 mais ce fichier et pour Excel 2007 donc ne fonctionne pas
j ai mis le fichier en pièce jointe
merci d avance
phv62
 

Pièces jointes

  • TEST FORUM3 fraterie.xlsx
    16.2 KB · Affichages: 2
Vote positif 0 Vote négatif
P

PHV62

XLDnaute Junior
JHA à dit:
job75 à dit:
Bonsoir,

Curieux que vous n'ayez pas accusé réception de mon post #5.

Le fichier fonctionne pourtant sur toutes versions Excel.

A+
Cliquez pour agrandir...
Cliquez pour agrandir...
bonjour job 75

j ai bien essaye le fichier mais en ligne 6 il ne fonctionne pas de ce faite je dois refaire mas feuille qui compte 241 cellules et ne sont pas dispose pareille au même endroit dans le même ordre que le fichier démo que j avais joint il correspond au test forum2 dans les message que j ai envoyé au dessus merci de regarder si vous le pouvez j ai remis le fichier
 

Pièces jointes

  • TEST FORUM2 (4).xlsx
    12.2 KB · Affichages: 3
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bonjour PHV62, salut Bruno,

Vous vous êtes enfin intéressé.

Il suffit de modifier un peu la macro pour traiter les nouvelles colonnes :
VB: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim P As Range, d As Object, tablo, i&, x$, resu()
Set P = Intersect(Range("A6:M" & Rows.Count), UsedRange.EntireRow)
If P Is Nothing Then Exit Sub
Set d = CreateObject("Scripting.Dictionary")
tablo = P.Resize(, 13) 'matrice, plus rapide
For i = 1 To UBound(tablo)
    x = tablo(i, 3)
    If x <> "" Then d(x) = d(x) & Chr(1) & tablo(i, 1)
    x = tablo(i, 4)
    If x <> "" Then d(x) = d(x) & Chr(1) & tablo(i, 1)
Next
ReDim resu(1 To UBound(tablo), 1 To 1)
For i = 1 To UBound(tablo)
    x = tablo(i, 13) 'colonne M
    If d.exists(x) Then resu(i, 1) = Mid(d(x), 2)
Next
'---restitution---
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
P.Columns(26).Resize(, Columns.Count - 25).ClearContents 'RAZ
P.Columns(26) = resu
P.Columns(26).TextToColumns P.Columns(26), xlDelimited, Other:=True, OtherChar:=Chr(1) 'commande Convertir
Application.EnableEvents = True 'réactive les évènements
End Sub
A+
 

Pièces jointes

  • TEST FORUM2 (4).xlsm
    20.7 KB · Affichages: 6
Vote positif 0 Vote négatif
P

PHV62

XLDnaute Junior
job75 à dit:
Bonjour PHV62, salut Bruno,

Vous vous êtes enfin intéressé.

Il suffit de modifier un peu la macro pour traiter les nouvelles colonnes :
VB: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim P As Range, d As Object, tablo, i&, x$, resu()
Set P = Intersect(Range("A6:M" & Rows.Count), UsedRange.EntireRow)
If P Is Nothing Then Exit Sub
Set d = CreateObject("Scripting.Dictionary")
tablo = P.Resize(, 13) 'matrice, plus rapide
For i = 1 To UBound(tablo)
    x = tablo(i, 3)
    If x <> "" Then d(x) = d(x) & Chr(1) & tablo(i, 1)
    x = tablo(i, 4)
    If x <> "" Then d(x) = d(x) & Chr(1) & tablo(i, 1)
Next
ReDim resu(1 To UBound(tablo), 1 To 1)
For i = 1 To UBound(tablo)
    x = tablo(i, 13) 'colonne M
    If d.exists(x) Then resu(i, 1) = Mid(d(x), 2)
Next
'---restitution---
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
P.Columns(26).Resize(, Columns.Count - 25).ClearContents 'RAZ
P.Columns(26) = resu
P.Columns(26).TextToColumns P.Columns(26), xlDelimited, Other:=True, OtherChar:=Chr(1) 'commande Convertir
Application.EnableEvents = True 'réactive les évènements
End Sub
A+
Cliquez pour agrandir...
Bonjour job75
merci pour le retour ca fonctionne
merci
 
Vote positif 0 Vote négatif

Discussions similaires

Dupins
  • Question
XL 2021 Planning visuel suivi multiprojets
Réponses
1
Affichages
342
AtTheOne
AtTheOne
K
  • Question
Tableau de suivi des jours de travail avec les absence les cp ......
Réponses
1
Affichages
240
sylvanu
sylvanu
G
  • Question
Microsoft 365 Validation des Données
Réponses
3
Affichages
204
AtTheOne
AtTheOne
almas
  • Question
XL 2016 liste déroulante en fonction d 'une donnés
2
Réponses
17
Affichages
1 K
almas
almas
S
  • Question
XL 2019 Remplir une combobox avec une ligne
2
Réponses
17
Affichages
1 K
fanch55
fanch55
M
  • Question
XL 2019 Transposer des données d'une feuille vers une autre sous forme de synthèse
Réponses
8
Affichages
262
mromain
mromain
M
  • Question
XL 2019 Copier des lignes les unes a la suite des autres dans une autre feuille sous conditions et seulement certaines colonnes
Réponses
7
Affichages
637
MGH
M
R
  • Question
XL 2021 Récupérer des données dans plusieurs classeurs sans les ouvrir - Résolu
Réponses
10
Affichages
470
job75
job75
D
  • Résolu(e)
Microsoft 365 Graphique avec plage de données glissante en partant d'une date
Réponses
5
Affichages
239
Dégé59
D
J
  • Question
Microsoft 365 extraction VBA avec formule si
Réponses
10
Affichages
546
Phil69970
Phil69970

Membres actuellement en ligne

12 membres et 131 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
315 123
Messages
2 116 460
Membres
112 756
dernier inscrit
amar13