satır renklendirme ?

[pitsss]

1	ali veli
1	ahmetmehmet
2	hasan hüseyin
2	dsfsd fsdf
5	fsdf hggh
5	hgfh hghj
45	5656 gtr
45	jhjhg k
6	jhgh fsddfs
9	sdfsdf ghhj
9	4534  7 56g
987	ghgfh  ghk
987	ghlklkj jkh

arkdaşlar kolay gelsin ;
sayfa1 de şu şekilde hücrelerim var. bu hücreleri ben yazdırmak istiyorum ancak. yazdırıken sayıları aynı olanların satırını gri yapsın,
sonra diğer aynı grubu boyamasın, ondan sonraki grubu yine gri yapsın ve yazdırsın istiyorum. yazdırdıktan sonra da tüm renkleri silsin istiyorum bunu nasıl yapabilirim acaba. denedim ama bi türlü olmadı malesef.
ekte ki kitaptaki gibi renklendirsin isitiyorum ama olmuyor.

 

[Ferhat Pazarçevirdi]

Aşağıdaki kodları ThisWorkBook kod module'üne kopyalayarak, çıktı almayı deneyiniz.

Dim iSon As Integer
[COLOR=darkgreen]'------------------------------------------[/COLOR]
Private Sub Workbook_BeforePrint(Cancel As Boolean)
    Cancel = True
    Application.EnableEvents = False
    Call Yazdirma_Oncesi_Sekillendir
    ActiveSheet.PrintPreview
    Range("A1:C" & iSon).Interior.ColorIndex = 0
    Application.EnableEvents = True
End Sub
[COLOR=darkgreen]'-----------------------------------------[/COLOR]
Private Sub Yazdirma_Oncesi_Sekillendir()
    Dim i As Integer
    Dim sKon As String
    Dim iRnk As Integer
    
    If ActiveSheet.Name = "Sayfa1" Then
    
        iSon = Cells(65536, 1).End(xlUp).Row
        
        Range("A1:C" & iSon).Interior.ColorIndex = 0
        
        For i = 1 To iSon
            If i = 1 Then
                sKon = Cells(i, 1)
                iRnk = 15
            Else
                If Cells(i, 1) <> sKon Then
                    sKon = Cells(i, 1)
                    If iRnk = 0 Then
                        iRnk = 15
                    Else
                        iRnk = 0
                    End If
                End If
            End If
            Range("A" & i & ":C" & i).Interior.ColorIndex = iRnk
        Next i
    
    End If
    
End Sub

 

[karakayalı]

sn ferhat bey, benzer türden bir sorunum var...ben "c" sutununda bulunan satıra "giriş" yazdığımda, "çıkış" yazdığımda ve "alındı" yazdığımda o satırın yazdığım değerlere göre renklenmesini istiyorum...yardımcı olursanız sevinirim..

 

[pitsss]

Aşağıdaki kodları ThisWorkBook kod module'üne kopyalayarak, çıktı almayı deneyiniz.

Dim iSon As Integer
[COLOR=darkgreen]'------------------------------------------[/COLOR]
Private Sub Workbook_BeforePrint(Cancel As Boolean)
    Cancel = True
    Application.EnableEvents = False
    Call Yazdirma_Oncesi_Sekillendir
    ActiveSheet.PrintPreview
    Range("A1:C" & iSon).Interior.ColorIndex = 0
    Application.EnableEvents = True
End Sub
[COLOR=darkgreen]'-----------------------------------------[/COLOR]
Private Sub Yazdirma_Oncesi_Sekillendir()
    Dim i As Integer
    Dim sKon As String
    Dim iRnk As Integer
    
    If ActiveSheet.Name = "Sayfa1" Then
    
        iSon = Cells(65536, 1).End(xlUp).Row
        
        Range("A1:C" & iSon).Interior.ColorIndex = 0
        
        For i = 1 To iSon
            If i = 1 Then
                sKon = Cells(i, 1)
                iRnk = 15
            Else
                If Cells(i, 1) <> sKon Then
                    sKon = Cells(i, 1)
                    If iRnk = 0 Then
                        iRnk = 15
                    Else
                        iRnk = 0
                    End If
                End If
            End If
            Range("A" & i & ":C" & i).Interior.ColorIndex = iRnk
        Next i
    
    End If
    
End Sub

cevabınız için çok teşekkürler. harika oldu sağolun.

kendim için şu şekilde kullandım. çok şime yaradı sağolun.

 Dim i As Integer
    Dim iSon As Integer
    Dim sKon As String
    Dim iRnk As Integer
     Sheets("randevu").Select
    If ActiveSheet.Name = "randevu" Then
    
        iSon = Cells(65536, "k").End(xlUp).Row
        
        Range("j2:q" & iSon).Interior.ColorIndex = 0
        
        For i = 2 To iSon
            If i = 2 Then
                sKon = Cells(i, "k")
                iRnk = 20
            Else
                If Cells(i, "k") <> sKon Then
                    sKon = Cells(i, "k")
                    If iRnk = 0 Then
                        iRnk = 20
                    Else
                        iRnk = 0
                    End If
                End If
            End If
            Range("j" & i & ":q" & i).Interior.ColorIndex = iRnk
        Next i
    
    End If

 

[Ferhat Pazarçevirdi]

sn ferhat bey, benzer türden bir sorunum var...ben "c" sutununda bulunan satıra "giriş" yazdığımda, "çıkış" yazdığımda ve "alındı" yazdığımda o satırın yazdığım değerlere göre renklenmesini istiyorum...yardımcı olursanız sevinirim..

Bunun için kod yazılabilir tabi, ama anlayabildiğim kadarıyla "Koşullu Biçimlendirme" ile rahatlıkla bu sorunun üstesinden gelebilirsiniz.

Forumda "Koşullu Biçimlendirme" olarak aratın, birçok güzel örnek bulacaksınız...