Autres ajouter des données correspondantes

PHV62 · 2 Janvier 2022

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

JHA · 3 Janvier 2022

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

PHV62 · 3 Janvier 2022

bonjour jha
j ai essaye ca marche correctement petite question pourquoi quand on rajoute une ligne dans la nouvelle cellule qui ce remplie il marque formule incohérente
sinon merci pour le retour rapide de la question

JHA · 3 Janvier 2022

Bonjour à tous,

Les plages sont peut-être différentes, peux-tu envoyer un exemple?

JHA

job75 · 3 Janvier 2022

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+

PHV62 · 4 Janvier 2022

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

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

JHA · 5 Janvier 2022

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

PHV62 · 6 Janvier 2022

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

JHA · 7 Janvier 2022

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

PHV62 · 10 Janvier 2022

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

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

job75 · 10 Janvier 2022

Bonsoir,

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

Le fichier fonctionne pourtant sur toutes versions Excel.

A+

PHV62 · 11 Janvier 2022

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...

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

job75 · 11 Janvier 2022

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+

PHV62 · 11 Janvier 2022

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+

Bonjour job75
merci pour le retour ca fonctionne
merci

Autres ajouter des données correspondantes

PHV62

XLDnaute Junior

Pièces jointes

JHA

XLDnaute Barbatruc

Pièces jointes

PHV62

XLDnaute Junior

JHA

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Pièces jointes

PHV62

XLDnaute Junior

Pièces jointes

JHA

XLDnaute Barbatruc

Pièces jointes

PHV62

XLDnaute Junior

JHA

XLDnaute Barbatruc

PHV62

XLDnaute Junior

Pièces jointes

job75

XLDnaute Barbatruc

PHV62

XLDnaute Junior

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

PHV62

XLDnaute Junior

Discussions similaires

Autres ajouter des données correspondantes

XLDnaute Junior

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Junior

XLDnaute Barbatruc

XLDnaute Barbatruc

Pièces jointes

XLDnaute Junior

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Junior

XLDnaute Barbatruc

XLDnaute Junior

Pièces jointes

XLDnaute Barbatruc

XLDnaute Junior

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Junior

Discussions similaires

Privacy & Transparency

Privacy & Transparency