Recopie de la valeur de la cellule fusionée

[treza88]

Bonjour a tous,

Je suis a la recherche d'une formule me permettant de recopier la valeur d'une cellule fusionnéedans le principe de l'image ci dessous.
Et comme je suis une bille en formule specifique j'espere que quelqu'un va pouvoir me donner un coup de pouce.
Merci d'avance

 

[Staple1600]

Bonsoir le fil, le forum

Fonctionne chez moi
(les cellules fusionnées sont en colonne A dans cet exemple)

Sub MergedCells_NextDoor()
Dim c As Range, p As Range
For Each c In Selection
If c.MergeCells Then
If c.Address = c.MergeArea.Cells(1, 1).Address Then
Range(Cells(c.Row, 2), Cells(c.MergeArea(c.MergeArea.Count).Row, 2)) = c
End If
End If
Next
End Sub

 

[Staple1600]

Re

Une variante (un peu plus court à écrire)

Sub Variante()
Dim c As Range, p As Range
For Each c In Selection
If c.MergeCells Then
If c.Address = c.MergeArea.Cells(1, 1).Address Then
Range(Replace(c.MergeArea.Address, "A", "B")) = c
End If
End If
Next
End Sub

 

[JHA]

Bonjour à tous,

Avec cette formule si j'ai tout compris

=RECHERCHE("zzzzz";$A$3:$A3)

recopier vers le bas

JHA

 

[Staple1600]

Bonjour le fil, le forum

@JHA
Merci de me rappeler de d'abord penser formules avant de réagir VBA
Par conséquent, j'utilise ta formule corrigée ainsi
=RECHERCHE("ToP_La_Formule_De_JHA_;-)";$A$1:$A1)

 

[treza88]

Bonjour et merci à vous deux pour vos propositions.

J'ai adapté ton code Staple1600 qui fonctionne parfaitement, merci.

Sub copie_fusion()
    Dim c As Range, p As Range, Selection As Range
    Set firstCell = Range("C9")
    Set lastCell = Range("C65536").End(xlUp)
    Set Selection = Range(firstCell, lastCell)
    'For Each c In Selection

    'If c.MergeCells Then

    'If c.Address = c.MergeArea.Cells(1, 1).Address Then
    'Range(Cells(c.Row, 4), Cells(c.MergeArea(c.MergeArea.Count).Row, 4)) = c

    'End If
    'Else
    'Range(Cells(c.Row, 4), Cells(c.Row, 4)) = c
    'End If
    'Next
    For Each c In Selection
        If c.MergeCells Then
            If c.Address = c.MergeArea.Cells(1, 1).Address Then
                Range(Replace(c.MergeArea.Address, "C", "D")) = c
            End If
            Else
            Range(Replace(c.Address, "C", "D")) = c
        End If
    Next
End Sub

J'ai essayé egalement la formule qui fonctionne egalement, mais je ne la comprend pas.
Pourquoi quand on met quelque chose de bidon dans la valeur recherché on obtient la valeur de la cellule fusionnée ?
C'est totalement incompréhensible pour moi, donc si un de vous deux a l'amabilité de me renseigner sur ce fonctionnement ça serat sympa.

Apres vaut il mieux utiliser la formule ou le code ?
Sachant que si j'utilise la formule quand le recalcule se fait ça mouline déja un peu, alors que le code lui se fera en decallé du recalcule.

Merci

 

[Staple1600]

Bonjour le fil, le forum

@treza88

Pourquoi quand on met quelque chose de bidon dans la valeur recherché on obtient la valeur de la cellule fusionnée ?
C'est totalement incompréhensible pour moi, donc si un de vous deux a l'amabilité de me renseigner sur ce fonctionnement ça serat sympa.

L'explication est déjà sur ton PC.
Dans l'aide d'Excel (touche F1)
Elle est aussi dans les archives du forum
(ou sur le net)

 

[Staple1600]

Re

Une macro qui utilise la formule (et sa soeur) de JHA
(la soeur de la formule, pas de JHA )

Sub Macro1()
If Not IsNumeric(Range("C9")) Then
Range("C9", Range("C" & Rows.Count).End(xlUp)).Offset(, 1).Formula = "=LOOKUP(""Staple²$"",$C$9:$C9)"
Else
Range("C9", Range("C" & Rows.Count).End(xlUp)).Offset(, 1).Formula = "=LOOKUP(9^9^9,$C$9:$C9)"
End If
End Sub

Et ta/ma macro copie_fusion réécrite sans Selection

Sub copie_fusion()
    Dim c As Range
    For Each c In Range("C9", Range("C" & Rows.Count).End(xlUp))
        If c.MergeCells Then
            If c.Address = c.MergeArea.Cells(1, 1).Address Then
                Range(Replace(c.MergeArea.Address, "C", "D")) = c
            End If
            Else
            c.Offset(, 1) = c
        End If
    Next
End Sub

 

[treza88]

Merci Staple1600, et désolé en même temps car, j'ai regardé avec F1 et j'ai trouvé ceci qui doit répondre a la question, mais je dois dire que je trouve ça pas trés claire.

Si la fonction RECHERCHE ne peut trouver l'argument valeur_cherchée, elle utilise la plus grande valeur de la matrice qui est inférieure ou égale à celle de l'argument valeur_cherchée.

Apparemment si je ne me trompe pas la fonction RECHERCHE et utilisé en Matriciel, mais aprés...

J'ai également regarder sur internet , mais je n'ai pas trouvé des exemples concret pour expliquer ce phénomène que je classerais de "paranormal" à mon niveau de compréhension.

Ps : tu va trop vite pour moi Staple1600 j'ai pas eu le temps de voir ton precedent message

 

[Staple1600]

Re

Tu as essayé les deux dernières macros que j'ai publiées (message #8) ?
Observe la différence des formules selon que la colonne C contient des nombres ou des valeurs texte.

Pour les explications, retournons par exemple en août 2010
http://www.astucesinternet.com/forum/topic2343.html#p10139

 

[eriiic]

Bonjour,

tant qu'on y est, une autre version plus courte :

Sub dupliqueFusion()
    Dim c As Range
    For Each c In [A2:A22]
        c.Offset(, 1) = c.MergeArea(1).Value
    Next c
End Sub

eric

 

[Staple1600]

Re, Bonjour eriiiic

Tant que nous y sonnes, une autre version paramétrable (avec un petit bout de plus court) et forcément un petit peu de plus long, mais c'est pour mieux paramétrer

Sub test()
'ici on indique la première cellule de la colonne contenant
'des cellules fusionnées
dFusion Range("D2")
End Sub
Private Sub dFusion(R As Range)
Dim c As Range
For Each c In Range(Cells(R.Row, R.Column), Cells(Rows.Count, R.Column).End(xlUp))
c(1, 2) = c.MergeArea(1).Value
Next c
End Sub

Et pour avoir la plus petite à sortir
(les soirs de plein de lune, dans les salons germano-pratins )

Private Sub cFusion_OnLiner()
Dim c As Range: For Each c In Selection: c(1, 2) = c.MergeArea(1): Next c
End Sub

PS: Merci à eriiiic pour son coup de ciseaux

 

[eriiic]

Tiens, je viens d'apprendre un mot

Suite à une opération elle plus longue mais plus rapide. On ne peut pas tout avoir... ;-)

Sub dupliqueFusion()
    Dim pl As Range, lig As Long
    For lig = 2 To Cells(Rows.Count, 1).End(xlUp).Row
        Set pl = Cells(lig, 1).MergeArea
        pl.Offset(, 1).Resize(pl.Rows.Count) = pl(1) ' .Resize car il doit y avoir un bug avec le range .MergeArea
        lig = lig + pl.Rows.Count - 1
    Next lig
End Sub

une seule opération d'écriture par fusion, et saut des cellules inintéressantes.
eric

 

[Staple1600]

Pour répondre une irrépressible tentation de tout raccourcir
(mon VBA doit être optionnellement et explicitement vérolé par un virus Jivaro

Avec quelques caractères en moins
(pour quel bénéfice? aucun mon capitaine )

Sub dupliqueFusion()
Dim pl, i&
For i = 2 To Cells(Rows.Count, 1).End(3).Row
Set pl = Cells(i, 1).MergeArea
pl(1, 2).Resize(pl.Rows.Count) = pl(1)
i = i + pl.Rows.Count - 1
Next
End Sub

 

[eriiic]

Tu as dû être rabbin dans une vie antérieure