Veri Girildikçe Hücre Kenarlıklarının Çizilmesi

[ahmedummu]

Merhaba arkadaşlar.

Aşağıdaki kodu forumda buldum. Kendi dosyama uyarladım ama kenarlıkları çizmiyor.

A ve Q sütunları arasında veri giriliyor. Yardımcı olursanız sevinirim.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [a6 :a65536]) Is Nothing Then Exit Sub
If Target.Text <> "" Then

KENARLIK_CIZILECEK_SATIR_NO = Target.Row
Set secim = Range("A" & KENARLIK_CIZILECEK_SATIR_NO & ":q" & KENARLIK_CIZILECEK_SATIR_NO).Borders
secim(xlDiagonalDown).LineStyle = xlNone
secim(xlDiagonalUp).LineStyle = xlNone
secim(xlEdgeLeft).LineStyle = xlContinuous
secim(xlEdgeLeft).Weight = xlThin
secim(xlEdgeLeft).ColorIndex = xlAutomatic
secim(xlEdgeTop).LineStyle = xlContinuous
secim(xlEdgeTop).Weight = xlThin
secim(xlEdgeTop).ColorIndex = xlAutomatic
secim(xlEdgeBottom).LineStyle = xlContinuous
secim(xlEdgeBottom).Weight = xlThin
secim(xlEdgeBottom).ColorIndex = xlAutomatic
secim(xlEdgeRight).LineStyle = xlContinuous
secim(xlEdgeRight).Weight = xlThin
secim(xlEdgeRight).ColorIndex = xlAutomatic
secim(xlInsideVertical).LineStyle = xlContinuous
secim(xlInsideVertical).Weight = xlThin
secim(xlInsideVertical).ColorIndex = xlAutomatic
End If

 

[kemal turan]

Merhaba
Koda gerek kalmadan Koşullu biçimlendirme yolu ile yapılabilir.
Örnek A2:Q500 arasını seçin.
Seçili halde iken Koşullu biçimlendirme>formül kullan bölümü ne =$A2:Q500 <>"" formülünü yazıp biçimlendirme de kenarlıkları belirtip tamam derseniz.A sütununa veri girildiğinde Q satırına kadar olan hücrelerde kenarlık oluşur.
Formülün başındaki Dolar işaretini koymaz iseniz Q satırına kadar sadece dolu hücrelerde kenarlık oluşur.
Selametle

 

[ahmedummu]

Teşekkürler Kemal Bey.

Çizilmesi gereken satırlar bazı ay 1, bazı ay 5, bazı aylarda 20 yani bunlar her ay değişiyor. (sayıları örnek verdim) ve çizilen yerlerin alt satırlarına metin, ad soyad, tarih vb. yazılıyor ve onlarında bulunduğu hücre kenarlıkları çiziliyor.

Aşağıdaki kodda A-Q sütünlarını tüm 65000 satırı çiziyor. Bu kodu aktif hücrenin çizilmesi gibi revize edilebilir mi?

sheets("DT").Range("A" & SATIR & ":Q" & SATIR).Borders.LineStyle = 1

 

[ahmedummu]

İlginize teşekkürler arkadaşlar. Sorun aşağıdaki döngü ile çözüldü

Dim a As Integer
For a = -1 To 15
ActiveCell.Offset(0, a).Borders.LineStyle = 1
Next a

 

[ahmedummu]

Bir de en son dolu satırın bir alt satırını A-Q sütunlarını birleştirmek istiyorum. Aşağıdaki kod ile yapmaya çalışıyorum. Neresinde yanlışlık varsa, veya bir öneriniz varsa yardımcı olabilir misiniz.

Range("a65536").End(xlUp).Select
ActiveCell.Offset(1, 0).Select
ActiveCell.Offset(0, 15).MergeCells = True

 

[Korhan Ayhan]

Merhaba,

Ekteki örnek dosyayı inceleyiniz.

1 .Sayfada koşullu biçimlendirme uygulanmıştır. (1000 satıra uygulanmıştır.)
2. Sayfada makro ile kenarlık uygulaması yapılmıştır.

 

[ahmedummu]

Merhaba arkadaşlar.

Korhan bey kenarlık çizme sorununu, aşağıdaki döngü ile çözmüştüm. İlginize teşekkür ederim. Yardım istediğim konu ise hücre birleştirme ile ilgili en alttaki kod.

Dim a As Integer
For a = -1 To 15
ActiveCell.Offset(0, a).Borders.LineStyle = 1
Next a

Bu kod ile dolu en son satırın bir alt satırını A-Q sütunlarını birleştirmek istiyorum. Nerede hata olduğunu veya başka bir kod ile yardımcı olursanız sevinirim.

Range("a65536").End(xlUp).Select
ActiveCell.Offset(1, 0).Select
ActiveCell.Offset(0, 15).MergeCells = True[

 

[Korhan Ayhan]

Birleştirme işlemi için aşağıdaki kodu deneyiniz.

Sub TEST()
    Son = Cells(Rows.Count, "A").End(3).Row + 1
    Range("A" & Son & ":Q" & Son).MergeCells = True
End Sub

 

[ahmedummu]

Korhan bey çok teşekkür ederim.

Birleştirme işlemi çözüldü. Bu kez ne son dolu satırın altına veri yazılacak. Yani birleştirilmiş hücreye, Tabi veri yazılmadan tekrar birleşmesi gerekiyor. Verdiğiniz kodun tersini yaptım ama olmadı bunun için de yardımcı olabilir misiniz. Şimdiden teşekkürler. Aşağıdaki gibi denedim olmadı. Bu kodları geçip diğer kodlar çalışıyor.

son = Cells(Rows.Count, "A").End(3).Row
Range("A" & son + 1 & ":Q" & son + 1).MergeCells = False

 

[ahmedummu]

Tamam Korhan bey çözüldü.