Satır renklendirme

[manisali50]

Arkadaşlar merhaba..
Sayfa sekmelerini renklendirdim.Bu renkler aynı zamanda "Sayfa1"deki "Bölüm Kodu" sütununa yazılan tezgah isimleriyle aynı..
İsteğim şu : (Örnekte görüleceği üzere) "Bölüm kodu"(I) sütununa tezgah ismi çıktığı anda sekmedeki renk ile boyansın istiyorum..Biliyorsunuz koşullu biçimlendirme ile üçünü başarabiliyorum..Forumda bulabilir miyim diye çok bakındım ama isteğimin tam karşılığını bulamadım..
Şimdiden teşekkürler
NOT : Renk kodlarını şöyle tespit ettim:
BORU BÖLÜMÜ : 38
CM TEZGAHLARI : 36
CT TEZGAHLARI : 34
KALIPHANE : 39
KAYNAK : 35
TESTERE : 33
ÜNİVERSAL : 40

 

[Emir Hüseyin Çoban]

Merhaba,

Dosya parola korumalı.

 

[manisali50]

Özür dilerim

Arkadaşlar çok özür dilerim..Şifresini kaldırıp dosyayı yeniledim

 

[Emir Hüseyin Çoban]

Merhaba, sorunuzu doğru anladıysam. Bu kodlar işinizi görecektir.

Sayfa1 in kod bölümüne ilave ediniz.

Private Sub Worksheet_Change(ByVal Target As Range)

On Error Resume Next
If Intersect(Target, [ı:ı]) Is Nothing Then Exit Sub
Sat = "A" & Target.Row & ":ı" & Target.Row
Select Case Target
Case "": Range(Sat).Interior.ColorIndex = 0

Case Is = "BORU BÖLÜMÜ": Range(Sat).Interior.ColorIndex = 36
Case Is = "CM TEZGAHLARI": Range(Sat).Interior.ColorIndex = 38
Case Is = "CT TEZGAHLARI": Range(Sat).Interior.ColorIndex = 34
Case Is = "KALIPHANE": Range(Sat).Interior.ColorIndex = 39
Case Is = "KAYNAK": Range(Sat).Interior.ColorIndex = 35
Case Is = "TESTERE": Range(Sat).Interior.ColorIndex = 33
Case Is = "ÜNİVERSAL": Range(Sat).Interior.ColorIndex = 40

End Select

End Sub

 

[İhsan Tank]

Arkadaşlar çok özür dilerim..Şifresini kaldırıp dosyayı yeniledim

buda benden olsun

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [I:I]) Is Nothing Then Exit Sub
Select Case UCase(Replace(Replace(Target, "ı", "I"), "i", "İ"))
Case Is = "TESTERE"
Target.Font.ColorIndex = 28
Case Is = "CT TEZGAHLARI"
Target.Font.ColorIndex = 34
Case Is = "KAYNAK"
Target.Font.ColorIndex = 35
Case Is = "CM TEZGAHLARI"
Target.Font.ColorIndex = 36
Case Is = "BORU BÖLÜMÜ"
Target.Font.ColorIndex = 38
Case Is = "KALIPHANE"
Target.Font.ColorIndex = 39
Case Is = "ÜNİVERSAL"
Target.Font.ColorIndex = 44
Case Else
Target.Font.ColorIndex = 0
End Select
End Sub

örnek dosya ekte

 

[manisali50]

Üstadım tekrar merhaba..Boş bir sayfada denedim gayet güzel çalışıyor..
Ancak dosyanın içindeki "sayfa1"in kod bölümünde "Tezgah_Arızalarını_Listele" kodu bulunduğu için bu kodun altına yapıştırdım fakat hata mesajı verdi ve Sat = "A" & Target.Row & ":ı" & Target.Row satırında "Sat" yazısının üzeri maviye boyandı..Çözümü nedir?

 

[manisali50]

Private Sub Worksheet_Change(ByVal Target As Range)

On Error Resume Next
If Intersect(Target, [ı:ı]) Is Nothing Then Exit Sub
Sat = "A" & Target.Row & ":ı" & Target.Row
Select Case Target
Case "": Range(Sat).Interior.ColorIndex = 0
Case Is = "BORU BÖLÜMÜ": Range(Sat).Interior.ColorIndex = 36
Case Is = "CM TEZGAHLARI": Range(Sat).Interior.ColorIndex = 38
Case Is = "CT TEZGAHLARI": Range(Sat).Interior.ColorIndex = 34
Case Is = "KALIPHANE": Range(Sat).Interior.ColorIndex = 39
Case Is = "KAYNAK": Range(Sat).Interior.ColorIndex = 35
Case Is = "TESTERE": Range(Sat).Interior.ColorIndex = 33
Case Is = "ÜNİVERSAL": Range(Sat).Interior.ColorIndex = 40

End Select

End Sub



Hüseyin çoban üstadımın verdiği bu kodları boş bir sayfada denedim gayet güzel çalışıyor..
Ancak asıl dosyanın içindeki "sayfa1"in kod bölümünde "Tezgah_Arızalarını_Listele" kodu da bulunduğu için mecburen bu kodun altına yapıştırdım fakat aynı sayfaya 2 ayrı kod yazılıp yazılmayacağını bilmediğim için hata mesajı verdi ve Sat = "A" & Target.Row & ":ı" & Target.Row satırında "Sat =" yazısının üzeri maviye boyandı..Çözümü nedir?
Acil yardımlarınızı bekliyorum

 

[Ömer]

Merhaba,

On Error Resume Next

satırından önce aşağıdaki kodu ilave ediniz.

Dim sat As String

.

 

[manisali50]

Üstad teşekkürler..İlgine ve emeğine sağlık..Sorun halloldu

 

[manisali50]

Üstadım sabah işyerime geldiğinde formülleri orijinal dosyaya aktardım..Ufak bir aksilik çıktı.
Satırları renklendiriyor fakat ilk aktardığımız anda değil.
Satırların üzerine gelip F2 tuşuna basıp,formül ortaya çıktıktan sonra enter tuşuna basıyorum ve satır renkleniyor..Basit bir ayrıntı ve önemli değil ama düzeltmenin yolu nedir?
Tekrar teşekkürler

 

[Ömer]

Üstadım sabah işyerime geldiğinde formülleri orijinal dosyaya aktardım..Ufak bir aksilik çıktı.
Satırları renklendiriyor fakat ilk aktardığımız anda değil.
Satırların üzerine gelip F2 tuşuna basıp,formül ortaya çıktıktan sonra enter tuşuna basıyorum ve satır renkleniyor..Basit bir ayrıntı ve önemli değil ama düzeltmenin yolu nedir?
Tekrar teşekkürler

Kod sayfa üzerinde veri girişi ile çalışır. Eğer istediğiniz gibi olacaksa buton yardımıyla bu işlemi yapmalısınız.

Sub Renklendir()
Dim i As Long
For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
    With Range("A" & i & ":I" & i)
        If Cells(i, "I") = "" Then
            .Interior.ColorIndex = 0
        ElseIf Cells(i, "I") = "BORU BÖLÜMÜ" Then
            .Interior.ColorIndex = 36
        ElseIf Cells(i, "I") = "CM TEZGAHLARI" Then
            .Interior.ColorIndex = 38
        ElseIf Cells(i, "I") = "CT TEZGAHLARI" Then
            .Interior.ColorIndex = 34
        ElseIf Cells(i, "I") = "KALIPHANE" Then
            .Interior.ColorIndex = 39
        ElseIf Cells(i, "I") = "KAYNAK" Then
            .Interior.ColorIndex = 35
        ElseIf Cells(i, "I") = "TESTERE" Then
            .Interior.ColorIndex = 33
        ElseIf Cells(i, "I") = "ÜNİVERSAL" Then
            .Interior.ColorIndex = 40
        End If
    End With
Next i
End Sub

.

 

[manisali50]

Üstadım merhaba..
Şehir dışında olmam münasebetiyle dosyayı şimdi uyarladım..tam istediğim gibi oldu.. İlginize ve emeğinize teşekkür ediyorum..