Birleştirilmiş hücredeki veriyi kodla başka hücreye otomatik aldırma

[sosyal2006]

Arkadaşlar Merhaba.
Birleştirilmiş A2 ve A3 hücresindeki veriyi birleştirilmemiş D2 ve D3 hücrelerine kod ile otomatik olarak aldırmak istiyorum.
Veya birleştirilmiş A2 ve A3 hücresine değer yazdığımızda D2 ve D3 hücrelerine otomatik formül yazsın.
Yardımlarınız için şimdiden teşekkürler.

 

[Ömer]

Merhaba,

D2 hücresine yazarak alt satırlara kopyalayınız.

=ARA(2;1/($A$2:A2<>"");$A$2:A2)

.

 

[sosyal2006]

Merhaba,

D2 hücresine yazarak alt satırlara kopyalayınız.

=ARA(2;1/($A$2:A2<>"");$A$2:A2)

.

Merhabalar.
Formülde bir hata var.Tabloda d2 hücresine formülü yazıp kopylaadığım zaman a14ve a15 hücresinde değer yok iken d14 ve d15 hücresindeki değer d12ve d13 hücresindeki değeri alıyor.
Ayrıca formülü çekmeyi unutursak diye kodlu veya otomatik formül ile çözüm arıyorum.

 

[Ömer]

kodlu veya otomatik formül ile çözüm arıyorum.

Yazdığınız için bende formül vermiştim.

Module kopyalarak çalıştırınız.

Sub Yaz()
 
    Dim i As Long, son As Range
 
    Range("A" & Cells(Rows.Count, "A").End(xlUp).Row).Select
 
    Do
        Set son = ActiveCell.Offset(1, 0)
    Loop While ActiveCell.EntireRow.Hidden = True
 
    Range("D2:D" & son.Row - 1).ClearContents
 
    For i = 2 To son.Row - 1
        Cells(i, "D") = Cells(i, "A")
        If Cells(i, "A") = "" Then
            Cells(i, "D") = Cells(i - 1, "D")
        End If
    Next i
 
End Sub

.

 

[sosyal2006]

Yazdığınız için bende formül vermiştim.

Module kopyalarak çalıştırınız.

Sub Yaz()
 
    Dim i As Long, son As Range
 
    Range("A" & Cells(Rows.Count, "A").End(xlUp).Row).Select
 
    Do
        Set son = ActiveCell.Offset(1, 0)
    Loop While ActiveCell.EntireRow.Hidden = True
 
    Range("D2:D" & son.Row - 1).ClearContents
 
    For i = 2 To son.Row - 1
        Cells(i, "D") = Cells(i, "A")
        If Cells(i, "A") = "" Then
            Cells(i, "D") = Cells(i - 1, "D")
        End If
    Next i
 
End Sub

.

Merhabalar.
Yardımlarınız için teşekkür ederim.Tam istediğim gibi olmuş.Bişeydaha sormak istiyorum.Peki aynı tabloda B2ve B3 hücresinide birleştirip E2 ve E3 hücresine aynı kodla aynı anda veriyi atmak istersek kodu nasıl yazmalıyız?

 

[Ömer]

Birleştirilen hücrelerin sayısı aynı mı olacak.

Yani;

A2:A5 arasını birleştirirseniz B2:B5 arasını mı birleştirecekseniz yoksa farklı olabilir mi?

.

 

[sosyal2006]

Birleştirilen hücrelerin sayısı aynı mı olacak.

Yani;

A2:A5 arasını birleştirirseniz B2:B5 arasını mı birleştirecekseniz yoksa farklı olabilir mi?

.

Evet aynı olacak.

 

[Ömer]

Bu şekilde deneyin.

Sub Yaz()
 
    Dim i As Long, son As Range
 
    Range("A" & Cells(Rows.Count, "A").End(xlUp).Row).Select
 
    Do
        Set son = ActiveCell.Offset(1, 0)
    Loop While ActiveCell.EntireRow.Hidden = True
 
    Range("D2:[COLOR=blue]E[/COLOR]" & son.Row - 1).ClearContents
 
    For i = 2 To son.Row - 1
        Cells(i, "D") = Cells(i, "A")
        [COLOR=blue]Cells(i, "E") = Cells(i, "B")[/COLOR]
        If Cells(i, "A") = "" Then
            Cells(i, "D") = Cells(i - 1, "D")
            [COLOR=blue]Cells(i, "E") = Cells(i - 1, "E")[/COLOR]
        End If
    Next i
 
End Sub

.

 

[sosyal2006]

Çok teşekkür ederim.Tam istediğim gibi olmuş.Emeğinize sağlık.

 

[sosyal2006]

Yanlız sonradan farkettim.A2 ve A3 hücresine değeri yazıp kodu çalıştırdıktan sonra a2 ve a3 hücresindeki değeri silip kodu çalıştırınca d2 hücresindeki değeri silip d3 hücresindeki değer silinmiyor.

 

[Ömer]

Yanlız sonradan farkettim.A2 ve A3 hücresine değeri yazıp kodu çalıştırdıktan sonra a2 ve a3 hücresindeki değeri silip kodu çalıştırınca d2 hücresindeki değeri silip d3 hücresindeki değer silinmiyor.

Bu yüzden diğer mesajımda tüm işlemler aynı mı olacak türünde bir soru sormuştum. Gün içinde yeniden düzenler geri dönüş yaparım.

.

 

[Ömer]

Sub Yaz()
 
    Dim i As Long, sOnA As Range, sOnB As Range
 
    Range("A" & Cells(Rows.Count, "A").End(xlUp).Row).Select
 
    Do
        Set sOnA = ActiveCell.Offset(1, 0)
    Loop While ActiveCell.EntireRow.Hidden = True
    
    Range("B" & Cells(Rows.Count, "B").End(xlUp).Row).Select
    
    Do
        Set sOnB = ActiveCell.Offset(1, 0)
    Loop While ActiveCell.EntireRow.Hidden = True
 
    Range("D2:E" & Rows.Count).ClearContents
 
    For i = 2 To sOnA.Row - 1
        Cells(i, "D") = Cells(i, "A")
        If Cells(i, "A") = "" Then
            Cells(i, "D") = Cells(i - 1, "D")
        End If
    Next i
    
    For i = 2 To sOnB.Row - 1
        Cells(i, "E") = Cells(i, "B")
        Cells(i, "E") = Cells(i, "B")
        If Cells(i, "B") = "" Then
            Cells(i, "E") = Cells(i - 1, "E")
        End If
    Next i
End Sub

İstediğiniz bu mu?

.

 

[sosyal2006]

Sub Yaz()
 
    Dim i As Long, sOnA As Range, sOnB As Range
 
    Range("A" & Cells(Rows.Count, "A").End(xlUp).Row).Select
 
    Do
        Set sOnA = ActiveCell.Offset(1, 0)
    Loop While ActiveCell.EntireRow.Hidden = True
    
    Range("B" & Cells(Rows.Count, "B").End(xlUp).Row).Select
    
    Do
        Set sOnB = ActiveCell.Offset(1, 0)
    Loop While ActiveCell.EntireRow.Hidden = True
 
    Range("D2:E" & Rows.Count).ClearContents
 
    For i = 2 To sOnA.Row - 1
        Cells(i, "D") = Cells(i, "A")
        If Cells(i, "A") = "" Then
            Cells(i, "D") = Cells(i - 1, "D")
        End If
    Next i
    
    For i = 2 To sOnB.Row - 1
        Cells(i, "E") = Cells(i, "B")
        Cells(i, "E") = Cells(i, "B")
        If Cells(i, "B") = "" Then
            Cells(i, "E") = Cells(i - 1, "E")
        End If
    Next i
End Sub

İstediğiniz bu mu?

.

Evet tam olarak budur.Teşekkürler.