Seçili Alanlara Makro Uygulama

[Erhan Üstünel]

Merhabalar..

Ekli dosyamdada belirttiğim gibi seçili satırların bazı hücrelerini birleştirmek istiyorum böyle bir makro mümkünmüdür ?

 

[hamitcan]

Renkli satırlar mı birleştirilecek ?

 

[Erhan Üstünel]

Evet Hocam, fakat renklendirmeyi seçili alan olarak işaret etmek amaçlı renklendirdim, örnek 9-10. satırları seçip renkli alanlardaki gibi B8-B9 , C8-C9 vs.

 

[Erhan Üstünel]

yani satırları işaretlediğimde G - J - L sutunlarınındaki hücreleri yukardan aşağıya birleştirmeyecek diye sölesek daha soğru olur sanırım, iki veya daha fazla satır aynı firmaya ait ama farklı plaka bilgilerini girmek için çok işime yarayacak

 

[hamitcan]

Mantık şöyle;seçili hücre ve altındakini birleştir.

Sub birlestir()
For Each hcr In Selection
 Range(hcr.Address, hcr.Offset(1, 0).Address).Merge
Next
End Sub

 

[Erhan Üstünel]

Peki hocam teşekkür ederim.. sanırım istediğim şekilde olmuyor

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz.

Satır seçtikten sonra makroyu çalıştırın.

Option Explicit
 
Sub SEÇİLİ_SATIRDAKİ_ALANLARI_BİRLEŞTİR()
    Dim İLK_SATIR As Long, SON_SATIR As Long
 
    İLK_SATIR = Split(Selection.Address(0, 0), ":")(0)
    SON_SATIR = Split(Selection.Address(0, 0), ":")(1)
 
    On Error Resume Next
    Application.DisplayAlerts = False
    Range("B" & İLK_SATIR & ":B" & SON_SATIR).Merge
    Range("C" & İLK_SATIR & ":C" & SON_SATIR).Merge
    Range("D" & İLK_SATIR & ":D" & SON_SATIR).Merge
    Range("E" & İLK_SATIR & ":E" & SON_SATIR).Merge
    Range("I" & İLK_SATIR & ":I" & SON_SATIR).Merge
    Range("K" & İLK_SATIR & ":K" & SON_SATIR).Merge
    Range("M" & İLK_SATIR & ":M" & SON_SATIR).Merge
    Application.DisplayAlerts = True
 
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[Erhan Üstünel]

Selamlar,

Aşağıdaki kodu denermisiniz.

Satır seçtikten sonra makroyu çalıştırın.

Option Explicit
 
Sub SEÇİLİ_SATIRDAKİ_ALANLARI_BİRLEŞTİR()
    Dim İLK_SATIR As Long, SON_SATIR As Long
 
    İLK_SATIR = Split(Selection.Address(0, 0), ":")(0)
    SON_SATIR = Split(Selection.Address(0, 0), ":")(1)
 
    On Error Resume Next
    Application.DisplayAlerts = False
    Range("B" & İLK_SATIR & ":B" & SON_SATIR).Merge
    Range("C" & İLK_SATIR & ":C" & SON_SATIR).Merge
    Range("D" & İLK_SATIR & ":D" & SON_SATIR).Merge
    Range("E" & İLK_SATIR & ":E" & SON_SATIR).Merge
    Range("I" & İLK_SATIR & ":I" & SON_SATIR).Merge
    Range("K" & İLK_SATIR & ":K" & SON_SATIR).Merge
    Range("M" & İLK_SATIR & ":M" & SON_SATIR).Merge
    Application.DisplayAlerts = True
 
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

Hocam çok teşekkür ediyorum elinize sağlık istediğim bu şekilde idi..