Renkli Hücrelerden otomatik olarak liste oluşturmak

[efeem]

https://drive.google.com/file/d/0B_7TqHqOwYWtSkdrdWlpdFktVU0/view?usp=sharing

bağlantıdan dosya indirilir mi bilmiyorum ama öğrencilerin seçtiği dersleri renklendirdikten sonra renk filtresi uygulayarak tek tek manuel olarak liste oluşturuyorum ama o dersin sayfasına o renk seçilen dersleri otomatik olarak atsa liste oluşturmakla uğraşmasam 10 numara olacak. Bir bilenden yardım istiyorum.

 

[Ömer BARAN]

Merhaba.
Aşağıdaki kod'u boş bir Modul'e kaydedip çalıştırın.
Sheet1 J sütunundakileri iki sayfaya aktarıyor.
Diğer sayfalar için de üzerinde değişiklik yaparak halledersiniz.
Bilgi: Kullandığınız renk kodları, 65535 -> SARI, 255 -> KIRMIZI, 12611584 -> MAVİ

Sub RENKAKTAR()
Dim Ku51 As Worksheet: Set Ku51 = Sheets("Kuran5-1")
Dim [B][COLOR="Red"]Ku52[/COLOR][/B] As Worksheet: Set Ku52 = Sheets("[B][COLOR="red"]Kuran5-2[/COLOR][/B]")
[SIZE="2"][COLOR="Red"][B]'.....BURAYA 3'ÜNCÜ SAYFA ADINA ait yukarıdaki gibi tanımlama satırı ekleyin[/B][/COLOR][/SIZE]
Dim sayfa As Worksheet: Set sayfa = Sheets("Sheet1")

Ku51.Range("C8:F" & Ku51.[C65536].End(3).Row).ClearContents
Ku52.Range("C8:F" & Ku52.[C65536].End(3).Row).ClearContents

Ku51.Cells(7, 3) = "Sınıfı": Ku51.Cells(7, 4) = "Okul No": Ku51.Cells(7, 5) = "Adı": Ku51.Cells(7, 6) = "Soyadı"
Ku52.Cells(7, 3) = "Sınıfı": Ku52.Cells(7, 4) = "Okul No": Ku52.Cells(7, 5) = "Adı": Ku52.Cells(7, 6) = "Soyadı"
    
    For sat = 19 To sayfa.[D65536].End(3).Row
        If sayfa.Cells(sat, [B][COLOR="Red"]10[/COLOR][/B]).Interior.Color = [B]65535[/B] Then '---> SARI
[B][COLOR="red"][SIZE="2"]'....Yukarıdaki 10 sayısı sütun numarasıdır, 10 J sütunu anlamına geliyor, başka sütun için örneğin K için 11 olarak değiştirin.[/SIZE][/COLOR][/B]
            satır = Ku51.[D65536].End(3).Row + 1
            Ku51.Cells(satır, 3) = sayfa.Cells(sat, 2)
            Ku51.Cells(satır, 4) = sayfa.Cells(sat, 3)
            Ku51.Cells(satır, 5) = sayfa.Cells(sat, 4)
            Ku51.Cells(satır, 6) = sayfa.Cells(sat, 5)
[SIZE="2"][B][COLOR="red"]'....Aşağıdaki kırmızı satırları kopyalayıp [COLOR="Blue"]End If satırından sonra[/COLOR] yapıştırın[/COLOR][/B]
[B][COLOR="red"]'....Mavi kısımlardaki sayfa adlarını yukarıda verdiğiniz ad neyse o şekilde değiştirin.[/COLOR][/B]
[B][COLOR="red"]'....[COLOR="Blue"]255[/COLOR] olan renk kodunu [COLOR="Blue"]12611584[/COLOR] olarak değiştirin.[/COLOR][/B]
[/SIZE][COLOR="red"]            
        ElseIf sayfa.Cells(sat, 10).Interior.Color = [B][COLOR="blue"]255[/COLOR][/B] Then '---> KIRMIZI
            satır = [B][COLOR="Blue"]Ku52[/COLOR][/B].[D65536].End(3).Row + 1
            [B][COLOR="Blue"]Ku52[/COLOR][/B].Cells(satır, 3) = sayfa.Cells(sat, 2)
            [B][COLOR="Blue"]Ku52[/COLOR][/B].Cells(satır, 4) = sayfa.Cells(sat, 3)
            [B][COLOR="Blue"]Ku52[/COLOR][/B].Cells(satır, 5) = sayfa.Cells(sat, 4)
            [B][COLOR="Blue"]Ku52[/COLOR][/B].Cells(satır, 6) = sayfa.Cells(sat, 5)
        End If
[/COLOR]10
Next

End Sub

 

[efeem]

Eywallah

Evet oldu Teşekkür ederim. ikinci ders için uyarladım 3 renk olanlarda nasıl yazılabilir bu kod acaba. Yukardaki kod 2 renk için gibi. Tek renkte kullandım. Ama 3 renk denemedim. bide her ders için uyarlamak baya bi vakit alcak gibi. mesela yukardaki renkler herzaman sabit değil sutunun üstündeki renkler değiştiğinde renk kodunu kodda değiştirmek lazım. Renk kodunuu o hücredeki renk ile kendisi eşleştirebilirmi. Ben istiyorum ki kod filan çalıştırmadan renkleri gireyim listeler oluşsun. Çok şey mi istedim bilmiyorum.

 

[Ömer BARAN]

Evet oldu Teşekkür ederim. ikinci ders için uyarladım 3 renk olanlarda nasıl yazılabilir bu kod acaba. Yukardaki kod 2 renk için gibi. Tek renkte kullandım. Ama 3 renk denemedim. bide her ders için uyarlamak baya bi vakit alcak gibi. mesela yukardaki renkler herzaman sabit değil sutunun üstündeki renkler değiştiğinde renk kodunu kodda değiştirmek lazım. Renk kodunuu o hücredeki renk ile kendisi eşleştirebilirmi. Ben istiyorum ki kod filan çalıştırmadan renkleri gireyim listeler oluşsun. Çok şey mi istedim bilmiyorum.

Estağfurullah, sorun değil.
Bir önceki cevabımdaki kod metni içerisine açıklamalar ekledim, tekrar bakınız.
O açıklamalara göre sanırım yaparsınız. Yapamazsanız konu sayfasına mesaj yazarsınız.
Aslında sayfa adları ile renklendirdiğiniz sayfadaki sütun başlıkları birebir uyuşsa çok daha pratik çözüm de bulunabilir.
Belgenizin yapısında değişiklik önermek istemedim.

 

[efeem]

Yapılabiliyor ancak

Ewet Tekrar teşekkürler. Ben açıkladığınız alanları çözdüm sadece 3 lü yada dörtlü renkleri nasıl ekleyebilirim on bilmiyordum şimdi o da oldu ancak dediğim gibi hala çok zamanımı alıyo bütün sütunların kodlarını tek tek düzeltmem gerekiyor. Bide bu dosya sadece 5. sınıflar için. Bunun 6. sınıfı var 7si 8 i bide aynı şekilde kursu var toplam 8 dosya. hepsinde farklı renkler var. dosyanın ana şeklini değiştirmekte bi sakınca yoktur. öğrencilerin seçtiği dersleri aynı satırda renklendirdiğimde daha sonra o sütunun bağlı olduğu sayfaya gidip çocuğu listeye kendisi eklesin rengi sildiğimde listeden çıkarsın istiyorum. bu kodda mesela renkleri kendimiz tanımlamamız gerekiyor. ben sheet sayfasında rengi değiştirebilirim. değiştirdiğimde listeleme işlemini ona öre yapmalı. bu şekilde olursa işimi çok kolaylaştıracak. şu anki haliyle listelerde değişiklik oldu mu süzüp listeyi kaydetmek çok zamanımı alıyor. sizin kod ile dediğim gibi 8 tane + bazı sınıflarda 25 ders var kodlama acaip zamanımı alacak. birde bu renk say makrosu var ama altta rengi değiştirdiğimde hücredeki sayı hemen değişmiyor. gidiyorum hücreye tıklıyorum sonra gösteriyor.

 

[Ömer BARAN]

Renklendirme yaptığınız sayfada I2, I3 ve I4'teki renklere göre aktarma yapmak için (tabi alt taraflarda da aynı renkleri kullanmalısınız); koddaki örneğin SARI -> 65535 yerine ilgili satırı aşağıdaki gibi değiştirerek, renk kontrolünü renk kodu üzerinden değil, I2, I3 ve I4 hücrelerine bağlayabilirsiniz.

        If sayfa.Cells(sat, 10).Interior.Color = [B][COLOR="Red"]sayfa.Range("I2").Interior.Color[/COLOR][/B] Then