Bir aralıktaki rengi ve içeriği belli hücrelerin sayısı

[shairane]

Değerli üstadlar merhaba,

Sorunumla ilgili forumda arama yapmama ragmen cozum olacak bir bilgiye ulasamadim. Eger tekrar olacak bir konu ise onceden affinizi dilerim.

Ekte verilen çalışma kitabında ilk sayfadaki belli bir aralikta, örneğin hücre dolgu rengi sarı olup aynı zamanda hücre değeri ST ile başlayan hücrelerin sayısını makro kullanarak nasıl 2. sayfaya yazdırabiliriz. 2 kriterin de doğru olması lazım. (Dolgu rengi Sarı ve ST ile başlayacak). Daha önce buna benzer birtakım şeyler yapmıştım ama açıkçası hücre değeri text olunca (ST14 gibi) ST kısmını makro kullanarak nasıl ayıklayacağımı bulamadım. :roll:

Dosyaya inceleyecek olursanız 2. sayfada hangi aralıkta hangi kriterlerin sorgulanacağı yazıyor.

Yardımlarınız için şimdiden çok teşekkür ederim.

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz.

Sub HESAPLA()
    [C3] = "": [C5] = "": [C7] = "": [C11] = "": [C13] = "": [C15] = ""
    For Each ALAN In Sheets("Area").Range("T20:GR159")
    If ALAN.Interior.ColorIndex = 6 And ALAN.Value Like "PT" & "*" Then
    [C3] = [C3] + 1
    ElseIf ALAN.Interior.ColorIndex = 6 And ALAN.Value Like "ST" & "*" Then
    [C5] = [C5] + 1
    ElseIf ALAN.Interior.ColorIndex = 6 And ALAN.Value Like "SB" & "*" Then
    [C7] = [C7] + 1
    ElseIf ALAN.Interior.ColorIndex = 4 And ALAN.Value Like "PT" & "*" Then
    [C11] = [C11] + 1
    ElseIf ALAN.Interior.ColorIndex = 4 And ALAN.Value Like "ST" & "*" Then
    [C13] = [C13] + 1
    ElseIf ALAN.Interior.ColorIndex = 4 And ALAN.Value Like "SB" & "*" Then
    [C15] = [C15] + 1
    End If
    Next
    MsgBox "İŞLEMİNİZ TAMAMLANMIŞTIR.", vbInformation
End Sub

 

[shairane]

maalesef

Sayın Cost Control,

Verdiginiz kodu denedim ancak maalesef ise yaramadi. Kisa bir sure islem yaptiktan sonra soru isaretlerinin bulundugu hucreler aynen kaliyor. Herhangi bir hesaplama sonucu goruntulenmiyor..

Selamlar,

Aşağıdaki kodu denermisiniz.

Sub HESAPLA()
    [C3] = "": [C5] = "": [C7] = "": [C11] = "": [C13] = "": [C15] = ""
    For Each ALAN In Sheets("Area").Range("T20:GR159")
    If ALAN.Interior.ColorIndex = 6 And ALAN.Value Like "PT" & "*" Then
    [C3] = [C3] + 1
    ElseIf ALAN.Interior.ColorIndex = 6 And ALAN.Value Like "ST" & "*" Then
    [C5] = [C5] + 1
    ElseIf ALAN.Interior.ColorIndex = 6 And ALAN.Value Like "SB" & "*" Then
    [C7] = [C7] + 1
    ElseIf ALAN.Interior.ColorIndex = 4 And ALAN.Value Like "PT" & "*" Then
    [C11] = [C11] + 1
    ElseIf ALAN.Interior.ColorIndex = 4 And ALAN.Value Like "ST" & "*" Then
    [C13] = [C13] + 1
    ElseIf ALAN.Interior.ColorIndex = 4 And ALAN.Value Like "SB" & "*" Then
    [C15] = [C15] + 1
    End If
    Next
    MsgBox "İŞLEMİNİZ TAMAMLANMIŞTIR.", vbInformation
End Sub

 

[Korhan Ayhan]

Selamlar,

Üstteki mesajıma örnek dosyanızı ekledim. İncelermisiniz.

 

[shairane]

Evet gonderdiginiz ornek dosya calisiyor. cok tesekkur ederim. Yalniz anlayamadigim nokta ayni kodlari ben ekledigimde neden calismadi? Sizin dosyanizla tek fark, ben summary sayfasinin kodlari icine eklemistim... Bunun haricinde hersey ayni..

Yardiminiz icin tekrar tesekkur ederim, benim icin cok faydali oldu.

Iyi calismalar dilerim.

 

[veyselemre]

Evet gonderdiginiz ornek dosya calisiyor. cok tesekkur ederim. Yalniz anlayamadigim nokta ayni kodlari ben ekledigimde neden calismadi? Sizin dosyanizla tek fark, ben summary sayfasinin kodlari icine eklemistim... Bunun haricinde hersey ayni..

For Each ALAN In Sheets("Area").Range("T20:GR159")

For Each ALAN In Range("T20:GR159")

 

[shairane]

Değerli üstadlar;

Geçtiğimiz hafta cevapladığınız bu soruma ek olarak sizlere bir sorum daha olacak. Fazla konu dağınıklığı olmasın diye 2. bir başlık açmayı uygun görmedim.

Sorum otomatik şekillerle ilgili. Excelde çizdiğimiz otomatik şekillerin bir takım özelliklerine göre hücrelere koşullu veri girişi yapabilir miyiz? Örneğin benim belli bir aralıkta bir çizgim var (otomatik şekil). Bu çizginin rengine göre ben A1 hücresine doğru veya yanlış yazdırmak istiyorum, mesela kırmızıysa 'doğru' siyahsa (yani otomatikse) 'yanlış' gibi. Ben ne yazık ki hiç bir yol bulamadım.

Yardımlarınız için şimdiden teşekkür eder, iyi çalışmalar dilerim