Hücre Birleştirme

[drejan62]

Merhabalar,
Arkadaşlar hücre birleştirme konusunda yardımınızı rica edecektim,
B sütununda eğerler bulunmakta bazı değerler birden fazla tekrar etmekte,benim istediğim bu alt alta tekrar eden değerlerin karşılığında bulunan A ve C sütunundaki hücreleri birleştirecek bir program yapabilmek.
örneğin;
B2,B3,B4 hücrelerinde aynı değer, B5,B6 hücrelerende aynı değer bulunsun.
yapacağımız program ile A2,A3,A4 hücreleri birleşsin aynı şekilde aynı olan A5,A6 hücreleride birleşsin.

Teşekkürler şimdiden.

 

[Necdet]

Merhaba,

Örnek dosya eklerseniz soruyu yanıtlayacak olan arkadaşımız daha net yanıt verebilir.

 

[drejan62]

Merhaba,

Örnek dosya eklerseniz soruyu yanıtlayacak olan arkadaşımız daha net yanıt verebilir.

örnek dosya ektedir
yardımcı olacaklara şimdiden zeşekkürler

 

[Necdet]

Merhaba,

Aşağıdaki kodları deneyebilirsiniz.

Sub HucreBirlestir()
    
    Dim i   As Long, _
        EskiSatırNo As Long, _
        SonSat      As Long, _
        SiroNo      As Long, _
        EskiDeğer   As String
    
    Application.DisplayAlerts = False
    
    SonSat = Cells(Rows.Count, "B").End(3).Row + 1
    
    Range("A2:A" & SonSat).UnMerge
    
    EskiSatırNo = 2
    EskiDeğer = [B2]
    
    For i = 2 To SonSat
        If Cells(i, "B") <> EskiDeğer Then
            sirano = sirano + 1
            With Range("A" & EskiSatırNo & ":A" & i - 1)
                .Merge
                .Value = sirano
            End With
            EskiSatırNo = i
            EskiDeğer = Cells(i, "B")
        End If
    Next i
End Sub

 

[drejan62]

Nejdet bey
çok teşekkür ederim
emeğinize sağlık
sağolun

 

[Necdet]

Güle güle kullanınız.

 

[eneskus]

Merhaba,

Aşağıdaki kodları deneyebilirsiniz.

Sub HucreBirlestir()
Dim i, EskiSatırNo As Long
Dim EskiDeğer As String
Application.DisplayAlerts = False
EskiSatırNo = 2
EskiDeğer = [B2]
For i = 2 To [B65536].End(3).Row + 1
    If Cells(i, "B") <> EskiDeğer Then
        Range("A" & EskiSatırNo & ":A" & i - 1).Merge
        EskiSatırNo = i
        EskiDeğer = Cells(i, "B")
    End If
Next i
End Sub

Kodlar ve çalışmanız için ellerinize sağlık vermiş olduğunuz kodları kendi dosyama ekledim ancak birleştirme işleminden sonra a sütünundaki değerler değiştirğinde makro önceden birleştirdiği hüçrelerde değişiklik yapmıyor bunu yeniden düzenliyecek şekilde ayarlamamız mümkünmü

yani b1 b2 b3 hüçrelerine yazılan değer aynı a1 a2 a3 hüçrelerini birleştiriyor şimdi b1 b2 b3 hüçrelerindeki veriyi silip b1 b2 aynı veri girilip b3 e farklı veri girilsede a1 a2 a3 birleştirilmiş şekilde kalmakta yeniden düzenlemesi mümkünmü
ilgilenirseniz memnun olurum

 

[Necdet]

Merhaba,

4 numaralı mesajımdaki kod ve dosyayı yeniledim.

Veri değişiklikliğini otomatiğe bağlamadım. Deneyiniz.