Doldu rengi olmayanları farklı yerlerde göstermek.

[soranadam]

Ekteki dostada sol tarafta gördüğünüz gibi renk olarak doldurmadığım yerleri otomatik olarak sağ tarafta örnekteki gibi nasıl gösterebilirim?

 

[Levent Menteşoğlu]

Bu işlemi yerinde filtreleyerek mi yapmak istiyorsunuz yoksa ayrı bir yere listelenmesini mi?

 

[soranadam]

Ayrı bir yere yapması daha iyi olacaktır.

 

[Levent Menteşoğlu]

Aşağıdaki kodu dosyanızda çalıştırarak deneyin.

Sub renksizlistele()
[g2:g65536].ClearContents
For a = 1 To [a65536].End(3).Row
If Cells(a, "a").Interior.ColorIndex = xlNone Then
c = c + 1
Cells(c + 1, "g") = Cells(a, "a")
End If
Next
End Sub

 

[soranadam]

Örnek tabloma uygulamanız mümkün mü?

 

[Levent Menteşoğlu]

Dosyanız ektedir.

 

[soranadam]

Öncelikle teşekkürler. Son bir sorum daha olacaktı. Ekte belirttiğim gibi 4 sütunda renk dolgusu yapılmayanların işaretlenmeyenler kısmında çıkması mümkün mü? Mümkün ise örnek dosyamda paylaşmanız mümkün mü?

 

[Levent Menteşoğlu]

Ekli dosyayı inceleyin.

 

[soranadam]

Çok teşekkürler. Peki şöyle birşey mümkün mü? Mesela 4 haftada da ortak olan sayıları tek bir yerde göstermek? Örnek ektedir? Bu son ricamdır.

 

[Levent Menteşoğlu]

Aşağıdaki kodu deneyin.

Sub renksizlistele()
[g2:j65536,m2:m65536].ClearContents
For Each hucre In Range("a2:d" & [a65536].End(3).Row)
If hucre.Interior.ColorIndex = xlNone Then
sut = hucre.Column + 6
sat = Cells(65536, sut).End(3).Row + 1
Cells(sat, sut) = hucre
sat1 = hucre.Row
say = WorksheetFunction.CountIf(Range("a" & sat1 & ":d" & sat1), hucre)
If say = 4 Then Cells(sat, "m") = hucre
End If
Next
End Sub

 

[soranadam]

Aslında demek istediğim; kod ile olan 4 hafta sabit kalacak, onlarda bir değişiklik olmayacak, tüm listeleme normal olacak, fakat orada her haftada sabit olan rakamlar örneğin sadece M sütununda nasıl gözükebilir? Mesela her haftada 2 rakamı sabit, M sütununda 2 çıkacak. Bir önceki örnekte yazdığım şekil? İlginiz için şimdiden teşekkürler.

 

[Levent Menteşoğlu]

10 Nolu mesajımdaki kodu değiştirdim. Tekrar deneyin.

 

[soranadam]

Teşekkür ederim. Tam olarak istediğim buydu. Sayenizde az çok bir şeyler öğrendim, ve öğrenmeye de devam edeceğim.

 

[soranadam]

Ne yazık ki bir sorunla karşılaştım. örnekte göreceğiniz gibi ilk haftada dolgu yaptığımda 1 ay göndermeyen sayfasında çıkmıyor, fakat diğer haftalarda işaretlediğimde 1 aydır göndermeyen kısmında çıkıyor. Normalde o haftalarda da dolgu yaptıklarımın 1 aydır göndermeyenlerde çıkmaması gerekli. Bu sorunu nasıl giderebilirim? Örnek ektedir?

 

[Levent Menteşoğlu]

Eski kodları silin ve aynı modüle aşağıdaki prosedür ve fonksiyonu kopyalayın.

Sub renksizlistele()
[g2:j65536,m2:m65536].ClearContents
For Each hucre In Range("a2:d" & [a65536].End(3).Row)
say = WorksheetFunction.CountIf(Range("m2:m65536"), hucre)
If renkkontrol(hucre.Row, hucre) = False And say = 0 Then
Cells(65536, "m").End(3).Offset(1, 0) = hucre
End If
If hucre.Interior.ColorIndex = xlNone Then
sut = hucre.Column + 6
sat = Cells(65536, sut).End(3).Row + 1
Cells(sat, sut) = hucre
End If
Next
End Sub

Function renkkontrol(sat, hucre) As Boolean
say = WorksheetFunction.CountIf(Range("a" & sat & ":d" & sat), hucre)
If say <> 4 Then GoTo 20
For a = 1 To 4
If Cells(sat, a).Interior.ColorIndex <> xlNone Then GoTo 20
Next
10 renkkontrol = False
Exit Function
20 renkkontrol = True
End Function

 

[soranadam]

Teşekkürler. Şimdi tam anlamıyla oldu.