Özel Destek İste

Excel istekleriniz için size özel alandan talep açın

Soru Sor

Excel ile ilgili bir sorunuz mu var, tıklayın

Hazır Dosya İndir

Binlerce Hazır Excel Dosyasını indirin
S

Satırlara Çizgi Ekleme ve Kesitlere Göre Hücrelerin Boyanması 2022-03-11

indirmek için izniniz yok
Satırlara Çizgi Ekleme ve Kesitlere Göre Hücrelerin Boyanması isimli dosya, makrolar ile bir şablonun istenilen bir görünüme nasıl kavuşturulacağını örneklendirmektedir.

Satırlara Çizgi Ekleme ve Kesitlere Göre Hücrelerin Boyanması

Sayfa Görünümünü Özelleştirme​

Üstteki resimde göreceğiniz şablonu, aşağıda tüm detayları ve açıklamaları yazılı olan kodlarla düzenliyoruz.
Kod:
Option Explicit
'Değişkenlerin mutalak tanımlansını sağlayan kod
Kod:
Sub Bicimlendir()
Dim rng As Range, sStr As Integer, sStn As Integer, stnAd As String
'rng: Excel hücresi olarak kullanacağım değişken.
'sStr: Son satır numara değerini saklayacak değişkenim.
'sStn: Son sütun numara değerini saklayacak değişkenim.
'stnAd: sütun adını saklayacak değişkenim.
'Soru: Sütun adı niye lazım?
'Range kullanarak adres bildirimi yapacağım zaman son satır değerinden
'başka bir de satırın altına çizgi eklerken son sütunu da
'hedef olarak kullanacağım. Range("A1:" & stnAd & sStr) gibi...

Set rng = ftrMaster.Range("A1048576")
'Son satırımı bulmak için Range tipindeki değişkenime değer ataması yaptım.
'Yani rng artık ftrMaster sayfasının A1048576. hücresinin kendisi oldu.

sStr = rng.End(xlUp).Row
'rng A1048576 idi. Bu hücreden yukarı çıktım. Bulduğum satır artık son satır
've bu satırın numara değerini aldım. Artık sStr benim için son satırın numarası.
'Değeri 421 çıktı. Son satırım 421 imiş.

Set rng = Nothing
'Range tipindeki değişkenimde A1048576 hücresi vardı, bu değeri artk taşımasın
'Değişkeni, yeni bir değer için kullanacağım.

Set rng = ftrMaster.Range("XFD1").End(xlToLeft)
'Son sütunumu bulmak için Range tipindeki değişkenime değer ataması yaptım.
'Yani rng artık ftrMaster sayfasının XFD1 sütunundan soldaki en ilk sütuna
'giderek son sütuna ulaşım. Artık rng son sütunu ifade ediyor.

stnAd = Split(rng.Address, "$")(1)
'Split function, ikinci parametresine verdiğiniz değere göre verinizi bölen
've geriye bir dizi döndüren bir fonksiyondur. Son sütunu bulmuştuk ya şimdi
'son sütunun adresinden sadece harf değerini alacağız. Bu fonksiyondan geriye
'bende "IX" adresi döndü. Peki öncesinde bu dizi de neler var dı?
'rng.Address kodu ile "$IX$1" değeri vardı, split bunu $ işaretlerine göre
'bir diziye çevirdi. Elemanları ise şunlar oldu: Birinci Eleman IX, ikinci elemanı 1
'Bana gereken 1. eleman Yani IX. Böylece; stnAd artık IX değerini saklıyor.

sStn = rng.Column
'Birde son sütunun sütun numara değerini aldım. Yani IX sütununun. Değeri: 256 imiş.

'ftrMaster sayfasının
'A1 hücresi ile
'stnAd sütunu arasında yani IX sütunu oluyor.
'Son Satırına kadar bir adres içinde çalışacağımı bildirdim.
'Burada şöyle bir veri var: ftrMaster.Range("A1:IX421")
With ftrMaster.Range("A1:" & stnAd & sStr)
    .Borders.LineStyle = xlNone
    'ftrMaster.Range("A1:IX421") arasındaki satırdaki çizgileri kaldırdım.
    .Interior.Color = xlNone
    'ftrMaster.Range("A1:IX421") arasındaki hücre renklerini kaldırdım.
    'Böylece sıfırdan satır çigisi ve renk ataması yapabilirim.
End With
'With bildirisinin sonu.

For Each rng In ftrMaster.Range("A1:A" & sStr)
'ftrMaster.Range("A1:A421") üzerinde bir döngü çalıştıracağım. Çünkü Son Satır değerim
'421 ve A1:A & 421 => A1:A421'i ifade ediyor.
    If rng <> rng(2, 1) Then
    'Ay değiştiğinde çizgi atacaktım. Ay verisi A sütununda, döngüde A sütununda dönüyor.
    'Böylece rng (A1, A2, A3, ..., A421), rng'nin bir alt hücresindeki değerden
    'farklıysa döngü bu satıra girer.
    'döndüğünden her dönüşünde, her satırı kendisinin bir altı ile aynı mı diye kontrol
    'eder. Hatırlatma: Bu arada döngü A1, A2, A3, A4, ..., A421 arasında dönüyordu.
       With ftrMaster.Range(rng, rng(1, sStn)).Borders(xlEdgeBottom)
       'Şimdi de A'dan başlayıp tüm sütun değerlerinin en sonunda olan sütuna kadar
       'olan satırların bir altına çizgi çekmek için bir adres bilgisi sundum.
       'rng ne idi (A1, ...,A421). rng (1, sStn)'deki sStn kaç idi: 256.
       'İşte burada A1 ile 256. sütun'a kadar işlem yapacağımı ifade ettim.
       'Döngü ilk dönüşünde burası A1:IX1 olur ,sonra A2:IX2,A3:IX3,A4:IX4,...,A421:IX421
       'Tabii ki, Borders(xlEdgeBottom) nedeni ile alt çizgi ifadesini sunmuş oldum.
         .LineStyle = xlContinuous
         'Çizgi stilim tek çizgi olsun.
         .Weight = xlMedium
         'Çigi kalın olsun.
       End With 'With sonu
    End If 'Ay farklı ise çalışan if sonu.
Next rng 'Döngü sonu

'Sıra geldi belirlediğim kesitlere göre renklendirme yapmaya.
Dim adresIlk As String, adresSon As String, stnKesit As Variant, i As Integer, dizi As Integer
'adresIlk renklendirmenin ilk sütununu ifade edecek, adresSon'da sonunu. Tabii ki döngü
'içinde her kesitin kendi sonu olacak ki farklı renklendirme yapabileyim.
'i renklendirme döngüsü için kullanacağım değişken. dizi değişkeni ise kesitlerimi saklamak için.
stnKesit = Array("Ay", "ftrMst", "ÇekMst", "ÇekKrt", "ÇekDty", "--ÇekKrtUpd", "BnkMst", "BnkDty")
'Şimdi burada bir Array (Dizi) listesi var. Yani ben, başlığı Ay, ftrMst, ÇekMst olan satırlarımı
'renklendirme için kesit olarak kullanacağım.
dizi = UBound(stnKesit)
'dizi adlı bir değişkenim var. Onda da kesit değerinin en büyüğünü tutuyorum. Şu anda sizce kaç
'değerin içeriyordur? 8 değil, 0'ı da sayın yani: 7 değeri var.
For i = 0 To dizi
'İşte bu sizi 0 ile 7 arasında dönecek. Neden? Kesitlerim arasında farklı renklendirme için.
    adresIlk = SutunAdi(CStr(stnKesit(i)), ftrMaster, 1048576)(0)
    'Kesit için başlangıç: Dizinin ilk değeri olan 'Ay' A sütununda olduğu için A döndü.
    'Birde döngünün ilk dönüşü için AJ döndü. Bu böyle her kesit için devam edecek.
    'SutunAdi adlı fonksiyonum ile de sütunların isim değerlerini buluyorum.
    On Error GoTo hata
    'Eğer hata oluşuyorsa, kesitin sonuna geldim demektir. Yani kesitin başlangıcı var ama sonu
    'yoktur. Yani boyanacak hücre kalmamıştır. Hata şu son iki satıra oluşur.
    adresSon = SutunAdi(CStr(stnKesit(i + 1)), ftrMaster, 1048576)(0)
    'Kesite göre her son adres değerini buluyorum.
    ftrMaster.Range(adresIlk & "1:" & adresSon & sStr).Interior.ColorIndex = 34 + i
    'Kesit başlangıcından bitişine kadar boyuyorum.
hata:
    If Err Then
    'Son kesitin boyanmasında yukarıdaki iki satır kodda hata oluşuyor ve bu satıra iniyorum.
    'Hata var ise Hata etiketine iniyorum.
    ftrMaster.Range(adresIlk & "1:" & stnAd & sStr).Interior.ColorIndex = 42
    'Kaldığım son boyanan hücrenin adresinden IX'e kadar boyuyorum.
    End If
Next i 'Boyama döngüsünün sonu.
End Sub
Kod:
Public Function SutunAdi(Optional stnAd As String, Optional sayfa As Worksheet, Optional sayi As Long = 1) As Variant
Dim result(4) As Variant
result(0) = Split(sayfa.Rows(1).Find(what:=stnAd, LookAt:=xlWhole, MatchCase:=True).Address(1, 0), "$")(0)
result(1) = result(0) & ":" & result(0)
result(2) = result(0) & sayi & ":" & result(0)
result(3) = result(0) & sayi
Set result(4) = sayfa
SutunAdi = result
End Function
Kod:
Private Sub Test()
Call SutunAd_ftrMaster
Debug.Print "0=>" & SutunAdi(Tip, ftrDetail)(0) & vbNewLine & _
"1=>" & SutunAdi(Tip, ftrDetail)(1) & vbNewLine & _
"2=>" & SutunAdi(Tip, ftrDetail)(2) & vbNewLine & _
"3=>" & SutunAdi(Tip, ftrDetail)(3)
End Sub
Bu aşamadan sonra dosyanın görüntüsü aşağıdaki gibi olmaktadır:

Satırlara Çizgi Ekleme ve Kesitlere Göre Hücrelerin Boyanması

Projeler Eşliğinde Formül ve Makro Eğitimi​

Makrolar hakkında daha detaylı bilgi almak isterseniz, "Projeler Eşliğinde Formül ve Makro Eğitimi" isimli eğitimi inceleyebilirsiniz.
Yazar
suzunkopru
İndirilme
7
Görüntüleme
178
İlk Yayınlama
Son Güncelleme
Değerlendirme
5.00 Oylama 2 İnceleme

Son incelemeler

Harika bir anlatım olmuş. Emeğinize sağlık.
S
suzunkopru
Çok Teşekkür ederim.
Kıymetli dostum, bu güzel örnek dosya için teşekkürler. Devamını bekleriz demekten de kendimi alamıyorum :)

Ellerine sağlık olsun.
S
suzunkopru
Çok Teşekkür ederim.
Üst Alt