birleştirilmiş hücreyi ayırma

[steppe]

A1 ve B1 Birleştirilmiş hücre=İstanbul yazıyor
B2 =b
B3 =c
A4 ve B4 Birleştirilmiş hücre=Antalya yazıyor
B5 =d
B6 =e

Yukarıdaki tabloda A1 ve B1 ayırınca İstanbul A1 hücresinde yazıyor
A4 ve B4 ayırınca Antalya A4 hücresinde yazıyor

Benim istediğim A1 ve B1 ayırınca İstanbul'un A1 hücresinde değilde B1 hücresinde yazmasını istiyorum
A4 ve B4 ayırınca Antalya'yı A4 hücresinde değilde B1 hücresinde yazmasını istiyorum

Diğer hücrelerin içerikleri B2,B3,B5 ve B6 aynı kalmasını istiyorum

Yardımlarınız için şimdiden teşekkürler.

 

[Ömer]

Merhaba,

a1,...a4 sabit bir değermidir. Sorunuzu daha detaylı açıklarmısınız.

 

[steppe]

Ömer kardeş soruyu yeniden düzenledim.A1 ve A4 sabit bir değer değil.

 

[steppe]

Birleştirilmiş hücreyi ayırma

Ekli dosyada ayrıntılı açıklama

 

[Korhan Ayhan]

Merhaba,

Aşağıdaki kodu denermisiniz.

Option Explicit
 
Sub BİRLEŞTİRİLMİŞ_HÜCRELERİ_DÜZENLE()
    Dim Hücre As Range, Say As Long
    
    For Each Hücre In Selection
        If Hücre.MergeCells = True Then
            Say = Say + 1
            Hücre.UnMerge
            Hücre.Offset(0, 1) = Hücre.Value
            Hücre.ClearContents
        End If
    Next
 
    If Say = 0 Then
        MsgBox "Birleştirilmiş hücre bulunamadı !", vbExclamation
    Else
        MsgBox "İşleminiz tamamlanmıştır."
    End If
End Sub

 

[Ömer]

Alternatif olsun.

Kodları module kopyalayın, kodların aktif hale gelmesi için dosyanızı kapatıp tekrar açın.

Artık fare sağ klik menüsünde yeni bir uygulama oluştuğunu göreceksiniz. "Yeni--->Hücre Çöz"

Çalışma mantığı : İstediğiniz aralığı fare ile seçin / bu aralıkta fare ile sağ kilik yapın ve "Yeni--->Hücre Çöz" seçeneğine tıklayın.

Bu işlemden sonra istediğiniz olacaktır.

Sub Auto_Open()
     FareMenu
End Sub
 
 Sub FareMenu()
 
     Dim cb As CommandBar, MenuObject
 
    Set cb = Application.CommandBars("Cell")
    Set MenuObject = cb.Controls.Add(Type:=msoControlButton, Temporary:=True)
 
     With MenuObject
             .OnAction = "[COLOR=blue]Coz[/COLOR]"
             .FaceId = 9
             .Caption = "[COLOR=red]Yeni--->Hücre Çöz[/COLOR]"
     End With
 
     Set cb = Nothing: Set MenuObject = Nothing
 
End Sub
 
Sub [COLOR=blue]Coz[/COLOR]()
 
    Dim hucre As Range
 
    Application.ScreenUpdating = False
 
    For Each hucre In Selection
        With hucre
            If .MergeCells = True Then
                .UnMerge
                .Offset(0, 1) = .Value
                .ClearContents
            End If
        End With
    Next hucre
 
    Application.ScreenUpdating = True
 
End Sub
 
 Sub Auto_Close()
     Application.CommandBars("Cell").Reset
 End Sub

 

[kayserciyes]

çözülen hücreleri birleşimdeki veri ile doldurma ?

Makro ile
birleştirilmiş hücrelerdeki başlık veya yazı çözüldüğünde çözüldüğü alanın hepsine yayılmasını nasıl yapa bilirim
yardımınız için teşekkür ederim
ekte örnek ekledim

Birden fazla birleştirilmiş hücre için aynı anda uygulana bilmeli

 

[Necdet]

Makro ile
birleştirilmiş hücrelerdeki başlık veya yazı çözüldüğünde çözüldüğü alanın hepsine yayılmasını nasıl yapa bilirim
yardımınız için teşekkür ederim
ekte örnek ekledim

Birden fazla birleştirilmiş hücre için aynı anda uygulana bilmeli

Merhaba sorunuz pek açık değil ama: aşağıdaki kodları birleştirilmiş hücre seçildikten sonra çalıştırıp deneyiniz.

Fikir vermesi açısından seçim ile yaptım.

Sub Makro1()
    
    Dim Sec As Range
    
    Set Sec = Selection
    
    Selection.UnMerge
    Range(Sec.Address) = Sec(1, 1)
    
End Sub

 

[kayserciyes]

Ellerine sağlık üsdat
Ancak birden fazla birleştirilmiş hücre varsa ilk hücredeki veri hepsine yazdırılıyor
ben her birleştirilmiş boluk için kendi verisi işlensin istiyorum
örnek dosyada ekledim incelerseniz
sizin kodu oraya uyguladığımda tüm sınıflar 5A oluyor oysa orda 3 tane farklı sınıf var