Hücredeki memurun derece/kademesine göre satırları renklendirme

Katılım
30 Nisan 2011
Mesajlar
71
Excel Vers. ve Dili
Excel-2007-2010
Altın Üyelik Bitiş Tarihi
16-04-2024
Merhaba arkadaşlar,
Ek dosyada maaş parametresinde memur derece/kademesine var burada yapmak istediğim
KH Der.Kad.
C
8- > 7-
7- > 6-
6- > 5-
5- > 4-
4- > 3-
3- > 2-
2- > 1-
C sütunundaki değerleri yukarıdaki değerlere göre satırları bulup renklendirsin istiyorum.
Saygılarımla.

Sicil No

Ad Soyad

KH Der.Kad.

EM Der.Kad.

Kıdem

Y.Dil Tazminatı

  

3-2 > 2-1

3-2 > 2-1

  
  

3-3 > 2-2

3-3 > 2-2

  
  

4-3 > 3-1

4-3 > 3-1

  
  

5-3 > 4-1

5-3 > 4-1

  
  

8-3 > 7-1

8-3 > 7-1

  
  

2-3 > 1-1

8-3 > 7-1

  
  

6-1 > 5-1

8-3 > 7-1

  
  

7-3 > 6-1

7-3 > 6-1

  
 
Katılım
30 Nisan 2011
Mesajlar
71
Excel Vers. ve Dili
Excel-2007-2010
Altın Üyelik Bitiş Tarihi
16-04-2024
Merhaba, ilginiz için teşekkür ederim. Makroyu denedim çalışmadı.
Makro bilgim olmadığı için acaba C sütunundaki yazılışı 8-3 > 7-1, fakat bulunmasını istediğim değer ise 8- > 7- şeklinde yazıldığı için aradaki - ile > karakterlerden kaynaklı bir durum olabilir mi?
Saygılarımla.
 
Katılım
30 Nisan 2011
Mesajlar
71
Excel Vers. ve Dili
Excel-2007-2010
Altın Üyelik Bitiş Tarihi
16-04-2024
Merhaba hocam, makronuz çalıştı emeğinize yüreğinize sağlık, ilginiz için Allah razı olsun çok teşekkür ederim.
ufak bir bölüm için ricam olacaktı mümkün ise koddaki şu yerleri
donusumTablosu.Add "8-", "7-"
donusumTablosu.Add "7-", "6-"
donusumTablosu.Add "6-", "5-"
donusumTablosu.Add "5-", "4-"
donusumTablosu.Add "4-", "3-"
donusumTablosu.Add "3-", "2-"
donusumTablosu.Add "2-", "1-"

şeklinde çalıştırılabilir mi?
Kod çalıştı fakat aşağıdaki gibi 1-1 > 1-2, 2-1 > 2-3 yani eşit olanlar gelmesin, eşit olmayanlar gelsin istiyorum. Yukarıdaki diziliş şeklinde olabilir mi?
  

1-1 > 1-2

1-1 > 1-2

  

2-1 > 2-3

2-1 > 2-3



Saygılarımla.
 
Son düzenleme:
Katılım
30 Nisan 2011
Mesajlar
71
Excel Vers. ve Dili
Excel-2007-2010
Altın Üyelik Bitiş Tarihi
16-04-2024
Merhaba hocam, gayretiniz için Allah razı olsun, örnek dosya yüklemek için Kurum serv hiç bir yerden yükleme yaptırmıyor,
Kodun renklendirmesinde sıkıntı yok, renklendirme tek renk olması yeterli olacaktır.
Renklendirmemesi gerekenler için örnek verecek olursak;
2-1 > 2-3,
2-2 > 2-3,
3-2 > 3-3,
3-1 > 3-2,
4-2 > 4-3,
7-2 > 7-3,
6-1 > 6-2, vb.
Renklendirmesi gerekenler için örnek verecek olursak;
3-2 > 2-1,
3-3 > 2-2,
4-3 > 3-1,
5-3 > 4-1,
8-3 > 7-1,
7-3 > 6-1, vb.
yerleri renklendirmesi yeterli olacaktır.
Saygılarımla.
 
Katılım
30 Nisan 2011
Mesajlar
71
Excel Vers. ve Dili
Excel-2007-2010
Altın Üyelik Bitiş Tarihi
16-04-2024
Merhaba hocam, Allah sizden de razı olsunç
Derece düşüşü olması durumunda renklendirme yapılması ve tek renk kullanılması için kodu düzenledim, yedek alıp dener misiniz;
Kod:
Sub SatirlariRenklendir()
    Dim ws As Worksheet
    Set ws = ActiveSheet
   
    Dim sonSatir As Long
    sonSatir = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row
   
    Dim renkDegeri As Long
    renkDegeri = RGB(255, 255, 200)
   
    Dim i As Long
    For i = 2 To sonSatir
        Dim dereceKademeMetni As String
        dereceKademeMetni = ws.Cells(i, 3).Value
       
        If Trim(dereceKademeMetni) <> "" Then
            Dim parcalar As Variant
            parcalar = Split(dereceKademeMetni, ">")
           
            If UBound(parcalar) >= 1 Then
                Dim solDeger As String
                Dim sagDeger As String
                solDeger = Trim(parcalar(0))
                sagDeger = Trim(parcalar(1))
               
                Dim solDerece As Integer, sagDerece As Integer
                Dim solKademe As Integer, sagKademe As Integer
                DereceKademeAyir solDeger, solDerece, solKademe
                DereceKademeAyir sagDeger, sagDerece, sagKademe
               
                If solDerece > sagDerece Then
                    ws.Rows(i).Interior.Color = renkDegeri
                End If
            End If
        End If
    Next i
    MsgBox "Satırlar derece/kademe değerlerine göre renklendirildi!", vbInformation, "İşlem Tamamlandı"
End Sub

Function DereceKademeAyir(dereceKademeMetni As String, ByRef derece As Integer, ByRef kademe As Integer)
    Dim pozisyon As Integer
    pozisyon = InStr(dereceKademeMetni, "-")
   
    If pozisyon > 0 Then
        On Error Resume Next
        derece = CInt(Left(dereceKademeMetni, pozisyon - 1))
        kademe = CInt(Mid(dereceKademeMetni, pozisyon + 1))
        On Error GoTo 0
    Else
        derece = 0
        kademe = 0
    End If
End Function
Merhaba hocam, Allah razı olsun, emeğinize, yüreğinize ve bilginize sağlık, makro çalıştı ve işimi kolaylaştırdı.
Allahta senin işlerini kolaylaştırsın varolasın selametle kal.
Saygılarım.
 

halit3

Uzman
Uzman
Katılım
18 Ocak 2008
Mesajlar
12,853
Excel Vers. ve Dili
2003 excell türkçe
ve
2007 excell türkçe
Alternatif olarak bir dosya yüklüyorum burada tarih olarak ilgili ay içinde terfisi gelenleri renklendiriyor sonra aktar düğmesine tıklayınca işlemler yapılıyor.

 

Ekli dosyalar

Katılım
30 Nisan 2011
Mesajlar
71
Excel Vers. ve Dili
Excel-2007-2010
Altın Üyelik Bitiş Tarihi
16-04-2024
Alternatif olarak bir dosya yüklüyorum burada tarih olarak ilgili ay içinde terfisi gelenleri renklendiriyor sonra aktar düğmesine tıklayınca işlemler yapılıyor.

Halit Hocam, ilginiz için teşekkür ederim.
Saygılarımla.
 
Son düzenleme:
Üst