Birleşik hücre değerlerini dağıtmak

[erdemzi]

Merhaba

excel sayfasında birden fazla birleştirilmiş hücreler bulunmaktadır. Bazı hücreler 2 satır olduğu gibi bazıları 20 satır birleştirilmiştir. Birleşen hücrede bir değer bulunuyor. Hücreleri makro yardımı ile, birleşenleri tespit edip hücreleri ayırırken ayrılan her hücreye birleşen hücredeki değeri yazdırmak mümkünmüdür ? yardımcı olabilir misiniz.
Örnek birkaç satırı aşağıda görselde paylaşıyorum.

My files - UploadNow.io

uploadnow.io

Karşılığı dolu yada boş ayrimi yapmaksızın birleşik hücre ayristirilirken her ayrılan hücreye aynı değeri yazacak

 

[Korhan Ayhan]

Merhaba,

Dosya yükleme sitelerine örnek dosyanızı yükleyip forumda paylaşırsanız destek almanız kolaylaşacaktır.

 

[erdemzi]

Merhaba,

Dosya yükleme sitelerine örnek dosyanızı yükleyip forumda paylaşırsanız destek almanız kolaylaşacaktır.

Merhaba bir görsel ekledim

 

[Korhan Ayhan]

Paylaştığınız görsele erişemedim. Örnek dosya eklemek bu kadar zor olmasa gerek..

 

[erdemzi]

Paylaştığınız görsele erişemedim. Örnek dosya eklemek bu kadar zor olmasa gerek..

Örnek1.jpg

Visit this link to download: Örnek1.jpg

files.fm

Yeniden ekliyorum

 

[erdemzi]

Örnek1.jpg

Visit this link to download: Örnek1.jpg

files.fm

Yeniden ekliyorum

File upload & sharing. Send large photos and videos. Online cloud storage.

File upload & sharing. Cloud file storage. Store, Share, Send or Sell your files, photos, videos, music and docs. Free signup.

files.fm

 

[Korhan Ayhan]

Deneyiniz.

Birleştirilmiş hücreleri seçtikten sonra kodu çalıştırınız.

Option Explicit

Sub Split_Concatenate_Cells()
    Dim Rng As Range, Data As Variant, Adres As String
    
    For Each Rng In Selection
        If Rng.MergeCells Then
            Adres = Rng.MergeArea.Address
            Data = Rng.Cells(1, 1).Value
            Rng.UnMerge
            Range(Adres).Value = Data
        End If
    Next

    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[erdemzi]

Deneyiniz.

Birleştirilmiş hücreleri seçtikten sonra kodu çalıştırınız.

Option Explicit

Sub Split_Concatenate_Cells()
    Dim Rng As Range, Data As Variant, Adres As String
   
    For Each Rng In Selection
        If Rng.MergeCells Then
            Adres = Rng.MergeArea.Address
            Data = Rng.Cells(1, 1).Value
            Rng.UnMerge
            Range(Adres).Value = Data
        End If
    Next

    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

çok teşekkürler, emeğinize sağlık.