koşula bağlı çizgi oluşturma

[Hacı Bayram ÖZKAN]

Merhaba arkadaşlar; Makro ile koşula bağlı çizgi oluşturmak istiyorum,
Örneğin; B15 Hücresine veri girdiğimde; A15:E15 satırlarında bulunan hücreleri tek çizgi ile çizmesini istiyorum. Bu olay döngü şeklinde B15'ten itibaren olacak.
Teşekkürler,

 

[uzmanamele]

Merhaba

Bunun için makroya gerek var mı? koşullu biçimlendirmeyle yapabilirsiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("b:b")) Is Nothing Then Exit Sub
If Target.Count <> 1 Then Exit Sub
Range("A" & Target.Row & ":" & "E" & Target.Row).Font.Strikethrough = True
End Sub

 

[Husgvarna]

Merhaba arkadaşlar; Makro ile koşula bağlı çizgi oluşturmak istiyorum,
Örneğin; B15 Hücresine veri girdiğimde; A15:E15 satırlarında bulunan hücreleri tek çizgi ile çizmesini istiyorum. Bu olay döngü şeklinde B15'ten itibaren olacak.
Teşekkürler,

Satıra çizgi içinse şöyle olabilir.
B15- B20 aralığına veri girildikçe çalışır.

 Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [b15:b20]) Is Nothing Then
A = Target.Row
With Range("a" & A & ":" & "e" & A).Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
    End With
 If Target.Cells = "" Then Range("a" & A & ":" & "e" & A).Borders(xlEdgeBottom).LineStyle = xlNone
End If
End Sub

 

[Hacı Bayram ÖZKAN]

Sayın Uzmanamele; Önçelikle markorya gerek vardı, çünkü koşullu biçimlendirme 3 den fazla olmadığı için makro istedim, diğer husus ise hücreye yazılan verinin üzerini değilde, hücreye veri girilince yani B15 hücresine veri girilince A15 ile E15 arasındaki hücrelerin kenar çizgilerini çizmesini istiyorum.
Sayın Husgvarna; sizin yaptığınız olmuş ancak sadece hücrelerin alt kısmını çiziyor, oysaki ben hücrelerin her tarafını çizmesini istedim bu şekilde bakarsanız sevinirim. İkinizinde emeğine sağlık.

 

[Seyit Tiken]

Şu linki bir inceleyiniz.
http://www.excel.web.tr/f14/ko-ula-baoly-kenarlyk-izimi-t112487.html

 

[Husgvarna]

Sayın Uzmanamele; Önçelikle markorya gerek vardı, çünkü koşullu biçimlendirme 3 den fazla olmadığı için makro istedim, diğer husus ise hücreye yazılan verinin üzerini değilde, hücreye veri girilince yani B15 hücresine veri girilince A15 ile E15 arasındaki hücrelerin kenar çizgilerini çizmesini istiyorum.
Sayın Husgvarna; sizin yaptığınız olmuş ancak sadece hücrelerin alt kısmını çiziyor, oysaki ben hücrelerin her tarafını çizmesini istedim bu şekilde bakarsanız sevinirim. İkinizinde emeğine sağlık.

[b15:b20] hücrelerine veri girdikçe çizgi ekler
silindiğinde çizgileri siler

 Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [b15:b20]) Is Nothing Then
A = Target.Row
With Range("a" & A & ":" & "e" & A)
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeRight).LineStyle = xlContinuous
[COLOR="#ff0000"]'...............................1.[/COLOR]
    End With
 If Target.Value = "" Then
 With Range("a" & A & ":" & "e" & A)
.Borders(xlEdgeLeft).LineStyle = xlNone
If Range("a" & A - 1 & ":" & "e" & A - 1).Borders(xlEdgeRight).LineStyle <> xlContinuous Then .Borders(xlEdgeTop).LineStyle = xlNone
If Range("a" & A + 1 & ":" & "e" & A + 1).Borders(xlEdgeRight).LineStyle <> xlContinuous Then .Borders(xlEdgeBottom).LineStyle = xlNone
.Borders(xlEdgeRight).LineStyle = xlNone
[COLOR="Red"]'...............................2.[/COLOR]
    End With
    End If
End If
End Sub

Hücre araları içinde gerekirse şunlarıda ilgili kırmızı bölümlerin yerine ekleyin.
1.

.Borders(xlInsideVertical).LineStyle = xlContinuous

2.

.Borders(xlInsideVertical).LineStyle = xlNone

 

[Hacı Bayram ÖZKAN]

Sayın Husgvarna: Teşekkürler;

 

[Hacı Bayram ÖZKAN]

Merhaba arkadaşlar, Sayın Husgvarna'nın hazırlamış olduğu, yukarıdaki kodda B15 hücresi ile B20 hücresine verileri girdiğimde çizgi ciziyor, bunları tek tek sildiğimde normal olarak siliniyor, ancak B15 İLE B20 yi kopmle seçtimiğimde, silme işlemini yapınca kod
If Target.Value = "" Then, bu satırda durarak sarı yanıyor. Bu hususta yardımcı olurmusunuz? Teşekkürler.

 

[Korhan Ayhan]

Merhaba,

Aşağıdaki kodu deneyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Hücre As Range
    
    If Intersect(Target, Range("B15:B" & Rows.Count)) Is Nothing Then Exit Sub
    
    Application.ScreenUpdating = False
    
    If Target.Cells.Count = 1 Then
        If Target <> "" Then
            Target.Offset(0, -1).Resize(1, 5).Borders.LineStyle = 1
        Else
            Target.Offset(0, -1).Resize(1, 5).Borders.LineStyle = 0
        End If
    Else
        For Each Hücre In Selection
            If Hücre.Row >= 15 And Hücre.Column = 2 Then
                If Hücre.Value <> "" Then
                    Hücre.Offset(0, -1).Resize(1, 5).Borders.LineStyle = 1
                Else
                    Hücre.Offset(0, -1).Resize(1, 5).Borders.LineStyle = 0
                End If
            End If
        Next
    End If
    
    Application.ScreenUpdating = True
End Sub

 

[Hacı Bayram ÖZKAN]

Korhan bey; enterasandır, B15 vey B16'ya veri gireceğim zaman cizmiyor, ama satırı komple işaretleyip B sütununa veri girilince ciziyor, bu yönde bir sıkıntı var,

 

[Murat OSMA]

Sizin tablonuz toplam 5 kolon mu, yani A:E aralığında mı ?

 

[Korhan Ayhan]

Merhaba,

Haklısınız. Üstteki mesajımdaki kodu güncelledim. Tekrar denermisiniz.

 

[Hacı Bayram ÖZKAN]

Korhan bey; eline sağlık şimdi oldu, sağlıcakla kal.

 

[Murat OSMA]

Sn. tarzanhaci konu çözüldü ama soruma bir yanıt alabilseydim sevinirdim..

 

[Hacı Bayram ÖZKAN]

Murat bey özür dilerim, sizi göremedim, sorunuza yanıt, hayır 5 kolon değil sadece B15'ten aşağı doğru yazdıkca olacaktı, bunuda sağolsunlar hallettiler, ilginize teşekkür ederim. Esen kalın.

 

[Murat OSMA]

Estağfurullah Sn. tarzanhaci,

Ben de bir kod önerecektim ama eğer sizin tablonuz B15'te aşağıya yazdıkça kenarlık olacak şekilde ve 5 sütunlu (A-B-C-D-E) olsaydı...

Teşekkür ederim.
İyi günler...