Alan Belirleme ve Kenarlık Koyma

[walabi]

Merhaba.

Ekli dosyada vba kodları ile alan belirleyip kenarlık koymak istiyorum. Kenarlık koyulacak alanları ise şöylesi bir şarta bağlı olarak belirlemem gerekiyor. M sütununda Yani Bakiye sütununda sıfır olmayan bakiye satırından başlayıp bakiyenin sıfırlandığı satıra kadar alan belirleyip bu satırlar arasında kalan alanı A ve N sütunları arasına kenarlık eklemek istiyorum.

Kısaca bakiye her sıfırlandığında bir önceki sıfır bakiye ile bir sonraki sıfır bakiyeyi görsel olarak ayırmak istiyorum. Nasıl bir çözüm olabilir. Örnek dosya ektedir.

Muhtemel çözüm önerileri içinde kenarlık ile beraber alanı renklendirme de olabilir. Ama çok zaruri değil.

 

[Necdet]

Merhaba,
Aşağıdaki kodları bir modüle kopyalayıp dener misiniz?

Sub Kenar()

Dim rng As Range
Dim i   As Long
Dim bsR As Long
Dim btR As Long
Dim drm As Boolean

Set rng = Range("a1").CurrentRegion

With rng
    .Borders.LineStyle = xlNone
    .Interior.ColorIndex = xlNone
End With

bsR = 2

For i = 2 To rng.Rows.Count
    If rng(i, 13) = 0 Then
        btR = i
        With Range(rng(bsR, 1), rng(btR, rng.Columns.Count))
            .BorderAround Weight:=xlThick, ColorIndex:=16
            If drm = False Then
                .Interior.ColorIndex = 19
                drm = True
            Else
                .Interior.ColorIndex = 43
                drm = False
            End If
        End With
        bsR = i + 1
    End If
 Next i

End Sub

 

[walabi]

Merhaba,
Aşağıdaki kodları bir modüle kopyalayıp dener misiniz?

Public Sub Kenar()

Dim rng As Range
Dim i   As Long
Dim bsR As Long
Dim btR As Long


Set rng = Range("a1").CurrentRegion

With rng
    .Borders(xlEdgeLeft).LineStyle = xlNone
    .Borders(xlEdgeTop).LineStyle = xlNone
    .Borders(xlEdgeBottom).LineStyle = xlNone
    .Borders(xlEdgeRight).LineStyle = xlNone
    .Borders(xlInsideVertical).LineStyle = xlNone
    .Borders(xlInsideHorizontal).LineStyle = xlNone
End With

bsR = 2

For i = 2 To rng.Rows.Count
    If rng(i, 13) = 0 Then
        btR = i
        Range(rng(bsR, 1), rng(btR, rng.Columns.Count)).BorderAround _
            Weight:=xlThick, _
            ColorIndex:=16
        bsR = i + 1
    End If
Next i

End Sub

Necdet bey teşekkürler. İstediğim gibi çalışıyor. Ellerinize sağlık.

 

[Necdet]

Merhaba,
Kodda kenarlık silme ile ilgili küçük bir değişiklik yaptım.

 

[walabi]

Merhaba,
Kodda kenarlık silme ile ilgili küçük bir değişiklik yaptım.

Değişikliği kaydettim teşekkürler. Son bir rica olarak belirlenen alanları 2 farklı renkte dönüşümlü olarak nasıl renklendirebilirim. Örneğin bir sarı bir yeşil bir sarı bir yeşil şeklinde olacak şekilde.

 

[Necdet]

Merhaba,
Çizginin amacı zaten ayırmak değil mi?
Üstelik kesişen çizgi var, bunun rengi ne olacak?
Pek mantıklı bulmadım doğrusu.
Ama yine de yapmak isterseniz koddaki ColorIndex ile belirleyebilirsiniz.

 

[walabi]

Merhaba,
Çizginin amacı zaten ayırmak değil mi?
Üstelik kesişen çizgi var, bunun rengi ne olacak?
Pek mantıklı bulmadım doğrusu.
Ama yine de yapmak isterseniz koddaki ColorIndex ile belirleyebilirsiniz.

Necdet bey özür dilerim. Eksik ifade etmişim. Siz sanırım kenarları farklı renklendirme olarak anladınız. Ben hücrelerin rengini değiştirmekten bahsetmek istemiştim.

 

[Necdet]

Merhaba,
Kodları yeniledim, deneyiniz.

 

[walabi]

Merhaba,
Kodları yeniledim, deneyiniz.

Teşekkürler. Ellerinize sağlık.