7 Koşula Göre Biçimlendirme

[kartal76]

Merhaba,

Sn.Yurttaş'ın 25.04.2006 tarihinde açmış olduğu "56 Koşula Göre Biçimlendirme" başlığında paylaştığı bilgiler ile bir dosyam üzerinde çalıştım. Kendisine yardım ve paylaşımları için tekrar teşekkür ediyorum.

Özetle; ihtiyacım olan 7 koşula bağlı hücre renklendirmesi. Ancak, hem hücre renklendirme, hemde bu şekilde Sayfa1'de oluşturulan listenin, Sayfa2'ye aktarılması ve burada büyükten küçüğe koşuluna bağlı olarak sıralanmasını bir tuşa atamak istememden dolayı işleri hayli karıştırdım.

Yapmak istediklerimle ilgili tüm açıklamaları, ekte gönderdiğim dosya üzerinde belirttim, umarım yeterli olur.

Yardımcı olabilecek arkadaşlar olursa memnun olurum.

İyi çalışmalar dilerim.

 

[mancubus]

ANA KOD SAYFASI'nın kod modülündeki kodları silin. bir modül ekleyin ve bu modüle aşağıdaki kodları kopyalayın.

şu alanlar sabit düşünülmüştür. satır veya sütun sayısının artma durumu var ise satır ve sütun numaraları M & cll.Row örneğindeki gibi değişkene atanabilir.
Worksheets("Sayfa1").Range("M3:W63")
Worksheets("Sayfa2").Range("B4:L64")

Sub deneme()

Dim ws1 As Worksheet, ws2 As Worksheet
Dim rng1 As Range, rng2 As Range, cll As Range

Set ws1 = Worksheets("Sayfa1")
Set ws2 = Worksheets("Sayfa2")
Set rng1 = ws1.Range("M3:W63")
Set rng2 = ws2.Range("B4:L64")

rng1.Interior.ColorIndex = xlNone
rng2.Interior.ColorIndex = xlNone

For Each cll In ws1.Range("N2:N" & Range("N65536").End(xlUp).Row)
    Select Case UCase(cll.Value)
        Case Is = "W": Range("M" & cll.Row & ":W" & cll.Row).Interior.ColorIndex = 2
        Case Is = "Y2": Range("M" & cll.Row & ":W" & cll.Row).Interior.ColorIndex = 7
        Case Is = "Z2": Range("M" & cll.Row & ":W" & cll.Row).Interior.ColorIndex = 29
        Case Is = "Y1": Range("M" & cll.Row & ":W" & cll.Row).Interior.ColorIndex = 30
        Case Is = "X2": Range("M" & cll.Row & ":W" & cll.Row).Interior.ColorIndex = 32
        Case Is = "Z1": Range("M" & cll.Row & ":W" & cll.Row).Interior.ColorIndex = 36
        Case Is = "X1": Range("M" & cll.Row & ":W" & cll.Row).Interior.ColorIndex = 45
        Case Else: Range("M" & cll.Row & ":W" & cll.Row).Interior.ColorIndex = xlNone
    End Select
Next

rng1.Copy ws2.Range("B4")
With rng2
    .Value = .Value
End With

End Sub

 

[kartal76]

Sn.Mancubus,

Öncelikle ilginize teşekkür ederim.
Mesajınızda belirtmiş olduğunuz uygulamayı yaptım. Ancak makroyu çalıştırınca;

Compile error:
Invalid outside procedure

şeklinde bir uyarı verdi ve işlem sonuçlandırılamadı.

Acaba benim göremediğim ve hatalı yaptığım bir şey mi var?

 

[mancubus]

prosedür dışında bazı kodların olduğunu gösterir genelde.

VBE'de iken insert -> module diyerek eklediğimiz modüle kodların tamamını kopyaladık değil mi?
diğer sayfadaki kodları da silerek?

ekteki dosyada problem yok.