Renge göre sırala

[ismailozkan4224]

DOSYAYI GÜNCELLEDİM.KOŞULLU BİÇİMLENDİRME İLE RENKLENDİ,kod var ama istediğimi yapmıyor.yada tam uyarlayamadım.
KIRMIZILAR 1 . SIRADA OLACAK
TURUNCULAR 2 . SIRADA OLACAK
SARILAR 3 . SIRADA OLACAK
MAVİLER 4 . SIRADA OLACAK
tşk.

 

[ismailozkan4224]

slm.arkadaşlar yok mu bu sorun için bir yardım acaba.

 

[Necdet]

Merhaba,

Koşullu Biçimlendirmede renk kodu alınamıyor, bu nedenle önce koşulları inceledim sonra kodları yazdım.

Umarım koşulu doğru anlamışımdır.

Sub DOGUMSIRALA_RENKRENK()
    
    Dim i As Long
    Dim j As Long
    
    Application.ScreenUpdating = False
    j = Cells(Rows.Count, "A").End(3).Row
 
    For i = 2 To j
        Cells(i, "N") = DateSerial(Year(Date), Month(Cells(i, "G")), Day(Cells(i, "G"))) - Date
        If Cells(i, "N") < 0 Then Cells(i, "N") = 9999
    Next i
 
    Range("A2:N" & j).Sort key1:=[N2]
    Range("N2:N" & j).Clear
 
    Application.ScreenUpdating = True
 
End Sub

 

[ismailozkan4224]

SLM NECDET BEY KOD ÇALIŞMIYOR
Range("A2:N" & j).Sort key1 DE HATA VERİYOR

 

[Necdet]

SLM NECDET BEY KOD ÇALIŞMIYOR
Range("A2:N" & j).Sort key1 DE HATA VERİYOR

Merhaba,

Kodu eksik yazmışım o yüzden

Range("A2:N" & j).Sort key1:=[N1]

olmalıydı.

Önceki mesajı yeniledim tekrar deneyiniz.

 

[ismailozkan4224]

DOSYAYI GÜNCELLEDİM.KOŞULLU BİÇİMLENDİRME İLE RENKLENDİ,kod var ama istediğimi yapmıyor.yada tam uyarlayamadım.
KIRMIZILAR 1 . SIRADA OLACAK
TURUNCULAR 2 . SIRADA OLACAK
SARILAR 3 . SIRADA OLACAK
MAVİLER 4 . SIRADA OLACAK
tşk.

 

[Necdet]

Merhaba,

3 nolu mesajı yeniledim, dosyayı ekledim. Deneyiniz.