Çözüldü Otomadik hücre birleştirme

[emre67z]

Arkadaşlar konu açiliyet gerektirmektedir.

Üstteki tablo elimizde olan bir tablo ve alttaki gibi makro ile yapabilme şansımız varmı. O sutunundan sıralama yapağımız için yapamıyoruz ve bizde önce sılayıp sonra hücreleri böyle birleştirelim dedik ama kısa bir süre ve yoğunluk çok fazla. 1650 Satır ve makro ile bu şekilde bir birleştirme yapılabilir mi ?

aynı sicilin karşısındaki toplam rapor günlerini ve sicil sahibinin adını birleştirsin

 

[çıtır]

Deneyiniz.Sayfa kodu

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [C2:C20000]) Is Nothing Then Exit Sub
Application.EnableEvents = False
Application.DisplayAlerts = False
Dim i As Integer
If Target.Count > 1 Then Exit Sub
For i = Cells(65535, "C").End(3).Row To 2 Step -1
If Range("C" & i) = Range("C" & i - 1) Then
Range(Cells(i, 3), Cells(i - 1, 3)).MergeCells = True
Range(Cells(i, 15), Cells(i - 1, 15)).MergeCells = True
End If
Next i
Application.EnableEvents = True
Application.DisplayAlerts = True
End Sub

 

[Muzaffer Ali]

Merhaba.
Alternatif olsun

Sub Birlestir()
    Dim Bak As Integer
    Dim SatirSay As Integer
    Dim Bul As Integer
    Application.DisplayAlerts = False
    SatirSay = Cells(Rows.Count, "C").End(3).Row
    For Bak = 2 To SatirSay
        For Bul = Bak To SatirSay
            If Cells(Bak, "C").Text = "" Or Cells(Bul, "C").Text = "" Then     
            ElseIf Cells(Bak, "C").Text = Cells(Bul, "C").Text Then
                Range(Cells(Bak, "C"), Cells(Bul, "C")).Merge
                Range(Cells(Bak, "O"), Cells(Bul, "O")).Merge
            Else
                Bak = Bul - 1
                Exit For
            End If
        Next
    Next
    Application.DisplayAlerts = True
End Sub

 

[emre67z]

Süper olmuş elinize sağlık. Dün yoğundu dönemedim çok işime yaradı sayın çıtır ve
dalgalikur

 

[assenucler]

emre67z,

Dosyanın son halini eklemeniz mümkün mü?
Teşekkürler.

 

[Muzaffer Ali]

Buyurun

 

[assenucler]

Teşekkürler Sayın dalgalikur.