Sağdaki hücrelerinin dolu olmasına bağlı olarak hücreleri birleştirmek

tamer42

Destek Ekibi
Destek Ekibi
Katılım
11 Mart 2005
Mesajlar
3,081
Excel Vers. ve Dili
Office 2013 İngilizce
Sağdaki hücrelerinin dolu olmasına bağlı olarak hücreleri birleştirmek

Merhabalar;

Ekli dosyada

"A" sütununda ID
"B" sütununda buna bağlı alt isimler var

"B" sütununda yeni bir alt isim girildiğinde; "A" sütununda ID değerinin bunların hepsini kapsayacak şekilde hücreleri birleştirmesi sağlanabilirmi;

Yani;
( "b2", "b3", "b4", "b5", "b6") dolu olduğunda;
"a2"; "a3"; "a4"; "a5"; "a6") tek bir hücre haline gelerek birleşecek.

bu işlemi;

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

altında yapabilirmiyim.


Teşekkürler, İyi Çalışmalar.
 

Kemal Demir

Özel Üye
Katılım
29 Temmuz 2004
Mesajlar
2,108
Merhaba,

Pek anlayamadım alan Aşagıdaki kod seçili alanları Merge eder.

Kod:
Sub MergeYap()
  For Each yer In Selection
    Selection.Merge
    Next
End Sub
 

tamer42

Destek Ekibi
Destek Ekibi
Katılım
11 Mart 2005
Mesajlar
3,081
Excel Vers. ve Dili
Office 2013 İngilizce
Merhabalar,

Aslında ben öncelikle


Private Sub Worksheet_Change(ByVal Target As Range)
....
.........
End Sub

olayı altında düşünmüştüm. Yani B sütununa yeni bir değer eklediğimde buna bağlı olarak "A" sütununda ID değerinin olduğu alanı buna göre ayarlasın. Yalnız bu durumda her seferinde işlem yapacağından yavaşlamasın diye en sonunda kaydederken bu işlemi yapsın demiştim.

Kısaca A sütununu B sütunundaki doluluk durumuna göre ayarlaması...


İyi Çalışmalar.
 

Kemal Demir

Özel Üye
Katılım
29 Temmuz 2004
Mesajlar
2,108
Belki Kod biraz uzun oldu ama zannedersem ısınızı gorecektır.

Kod:
Sub Merge()
Application.DisplayAlerts = False
atla = False
rng = "a2"
For x = 2 To 25
Cells(x, 1).Select
If Cells(x, 2).Value = "" Then
atla = True
Else
If atla = True Then
sat = Range("a" & ActiveCell.Row).Row
kol = Range("a" & ActiveCell.Row).Column
rng = Chr(kol + 64) & sat
atla = False
End If
Range(rng & ":" & "a" & x).Select
Selection.Merge
End If
Next
End Sub
Ek'teki Dosyaya bakınız
 
Üst