• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

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

  • Konbuyu başlatan Konbuyu başlatan Kemter
  • Başlangıç tarihi Başlangıç tarihi
Katılım
30 Nisan 2011
Mesajlar
73
Excel Vers. ve Dili
Excel-2007-2010
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




 
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.
 
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:
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.
 
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.
 
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

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:
Geri
Üst