Şartlı Hücre Birleştirme Makrosu

[gertt]

Merhaba.
D5 ile D100 arasında bazı veriler var.İki değer arasındaki boş hücreleri birleştirmek istiyorum.
Örneğin;D5 hücresinde değer var (Dolu).D6,D7,D8 hücreleri boş, D9 hücresi dolu.D5 ile D8 hücrelerinin birleştirilmesi, D9'dan diğer dolu hücreye kadar olan kısmında aynı şekilde, ................ hücrelerinin birleştirilmesini sağlayan bir kod yazmamız mümkün mü?
Teşekkürler.

 

[Korhan Ayhan]

Merhaba,

Aşağıdaki kodu deneyiniz.

Sub BOŞLARI_BİRLEŞTİR()
    Dim Hücre As Range, Adres_1 As String, Adres_2 As String
    
    For Each Hücre In Range("D5:D100")
        If Hücre.Value = "" Then
            If Adres_1 = "" Then
                Adres_1 = Hücre.Address
            End If
            Adres_2 = Hücre.Address
        Else
            If Adres_1 <> "" And Adres_2 <> "" Then
                Range(Adres_1 & ":" & Adres_2).Merge
                Adres_1 = ""
                Adres_2 = ""
            End If
        End If
    Next
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[gertt]

Korhan Bey, merhaba.
Kodu çalıştırdığımda:

Run-time error '1004':
Method 'Range of object'_ Global' failed

hatasını vermektedir.Teşekkürler.

 

[Korhan Ayhan]

Merhaba,

İş çıkışında tam test edemeden foruma eklemiştim. İlk hücre dolu olduğunda hata veriyordu. Kodu güncelledim. Tekrar deneyiniz.

 

[gertt]

Korhan Bey şimdi oldu.Tekrar teşekkürler.Elinize sağlık...

 

[gertt]

Merhaba.
Verinin bulunduğu hücreyi de veriyle birlikte birleştirilen hücrenin içerisine dahil edebilir miyiz?
Örneğin5'de veri var.D6 boş.D7'de veri var.Veriyi kaybetmeden D5 ile D6'yı birleştirebilir miyiz?
Diğer hücrelerde aynı şekilde.Verilerin yeri sabit değil,değişken.
Teşekkürler...

 

[gertt]

Yardım edebilecek arkadaş var mı?

 

[bunyaming]

Merhaba.
Verinin bulunduğu hücreyi de veriyle birlikte birleştirilen hücrenin içerisine dahil edebilir miyiz?
Örneğin5'de veri var.D6 boş.D7'de veri var.Veriyi kaybetmeden D5 ile D6'yı birleştirebilir miyiz?
Diğer hücrelerde aynı şekilde.Verilerin yeri sabit değil,değişken.
Teşekkürler...

merhaba,
bu sorunun cevabına benimde ihtiyacım oldu, yardımcı olabilirseniz sevinirim
teşekkürler

 

[Ömer BARAN]

merhaba,
bu sorunun cevabına benimde ihtiyacım oldu, yardımcı olabilirseniz sevinirim
teşekkürler

Merhaba.

Cevabımın altındaki İMZA bölümünü okuyunuz.
.

 

[bunyaming]

Merhaba.

Cevabımın altındaki İMZA bölümünü okuyunuz.
.

Merhaba Ömer Bey,

daha önce sorulmuş diye eklememiştim özüür diliyorum hemen ekliyeyim.
yine aynı konu hakkında siz bana yardımcı olmuştunuz bir makro yazmıştınız.
Fakat bugün denemelerimde birleştirme yaparken bir kaç farklı veriyi silip diğerleri ile birleştirdiğine şahit oldum,işin içinden çıkamadım.
yazdığınız makro ve örnek dosya eklidir
yardımcı olursanız sevinirim
teşekkürler

 

[bunyaming]

Merhaba Ömer Bey,

daha önce sorulmuş diye eklememiştim özüür diliyorum hemen ekliyeyim.
yine aynı konu hakkında siz bana yardımcı olmuştunuz bir makro yazmıştınız.
Fakat bugün denemelerimde birleştirme yaparken bir kaç farklı veriyi silip diğerleri ile birleştirdiğine şahit oldum,işin içinden çıkamadım.
yazdığınız makro ve örnek dosya eklidir
yardımcı olursanız sevinirim
teşekkürler

aynı konu diye bu soru üzerinden yazdım
farklı bir konu başlığı ve mesaj ile yeniden sormalımıyım?

 

[Ömer BARAN]

Tekrar merhaba.
Aşağıdaki kod istenileni yapacaktır.
Dikkat: A sütununda son dolu hücrede " - " işareti var onu silerek kodu çalıştırabilirsiniz.

Sub BIRLESTIR()
enson = Cells(Rows.Count, 1).End(3).Row + 1
[B:B].VerticalAlignment = xlCenter: [B:B].UnMerge
For sat = 3 To Cells(Rows.Count, 1).End(3).Row
    If Cells(sat, "B") <> "" And Cells(sat + 1, 2) = "" Then
        son = WorksheetFunction.Min(enson, Cells(sat, 2).End(xlDown).Row)
        Range(Cells(sat, "B"), Cells(son - 1, "B")).Merge: sat = son - 1
    End If
    If son = enson Then Exit For
Next
End Sub

 

[bunyaming]

Tekrar merhaba.
Aşağıdaki kod istenileni yapacaktır.
Dikkat: A sütununda son dolu hücrede " - " işareti var onu silerek kodu çalıştırabilirsiniz.

Sub BIRLESTIR()
enson = Cells(Rows.Count, 1).End(3).Row + 1
[B:B].VerticalAlignment = xlCenter: [B:B].UnMerge
For sat = 3 To Cells(Rows.Count, 1).End(3).Row
    If Cells(sat, "B") <> "" And Cells(sat + 1, 2) = "" Then
        son = WorksheetFunction.Min(enson, Cells(sat, 2).End(xlDown).Row)
        Range(Cells(sat, "B"), Cells(son - 1, "B")).Merge: sat = son - 1
    End If
    If son = enson Then Exit For
Next
End Sub

Merhaba Ömer Bey

şuan tamamdır, teşekkürler

 

[ilyaskaragoz]

B sütünuna yapılan bu birleştirme işlemini A,B,C,D,E Hücrelerine de yapmak istiyorum nasıl bir kod olması lazım