Yazılan rakam toplamı adedince hücre renklendirme???

[alpeki99]

Merhaba.

Her defasında farklı adette gelen çuvalların miktarını bir sütunda aşağı doğru yazıyorum. Toplam çuval adedi 600 tane ve buna eşit miktarda hücreyi çerçeve içine aldım.

Benim istediğim 2,5,10,1,....... vb. adette gelen çuvalları toplayıp bunların toplamı kadar kutuyu yani hücreyi renklendirmesi.

Ekte gerekli örnek var. Yardımlarınız için teşekkür ederim.

 

[Necdet]

Merhaba,

Public Sub Renklendir()
Application.ScreenUpdating = False
Range("B2:BI12").Interior.ColorIndex = xlNone
For i = 2 To [BK65536].End(3).Row - 1
Range(Cells(i, "B"), Cells(i, 2 + Cells(i, "BK"))).Interior.ColorIndex = 3
Next i
End Sub

 

[Korhan Ayhan]

Selamlar,

Alternatif olarak ekteki örnek dosyayı incelermisiniz.

 

[alpeki99]

Merhaba.

Öncelikle ilginize teşekkür ederim. Necdet Bey örneğiniz için teşekkür ederim zannederim tam anlatamamışım. Sayıların toplamı her satır için ayrı ayrı renklendirme değilde peş peşe renklenecekti.

Korhan Bey sizede teşekkür ederim. İstediğim şey sizin vermiş olduğunuz örnekteki gibi bir çözüme ihtiyacım vardı. Ellerinize sağlık her ikinizinde.

 

[1Al2Ver]

Merhaba,

Macro'da 1 fazla hesaplama var ve mümkünse küçük bir ilave rica ediyorum,

Teşekkür ederim, saygılarımla.

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki koddaki kırmızı renkli bölümü 1 olarak değiştirip denermisiniz.

Range(Cells(i, "B"), Cells(i, [COLOR=red][B]2[/B][/COLOR] + Cells(i, "BK"))).Interior.ColorIndex = 3

 

[1Al2Ver]

Selamlar,

Aşağıdaki koddaki kırmızı renkli bölümü 1 olarak değiştirip denermisiniz.

Range(Cells(i, "B"), Cells(i, [COLOR=red][B]2[/B][/COLOR] + Cells(i, "BK"))).Interior.ColorIndex = 3

Sayın Korhan Ayhan,

Teşekkür ederim, bu halloldu, peki boyadığı yerlere sayı yazabilir mi ?

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki şekilde denermisiniz.

Public Sub Renklendir()
    Application.ScreenUpdating = False
    Range("B2:BI12").Interior.ColorIndex = xlNone
    Range("B2:BI12").ClearContents
    For i = 2 To [BK65536].End(3).Row - 1
        If Range("BK" & i) > 0 Then
        Range(Cells(i, "B"), Cells(i, 1 + Cells(i, "BK"))).Interior.ColorIndex = 3
        Range("B" & i) = "1"
        End If
        If Range("BK" & i) > 1 Then
        Range("B" & i).AutoFill Destination:=Range(Cells(i, "B"), Cells(i, 1 + Cells(i, "BK"))), Type:=xlFillSeries
        End If
    Next i
    Application.ScreenUpdating = True
End Sub

 

[1Al2Ver]

Selamlar,

Aşağıdaki şekilde denermisiniz.

Public Sub Renklendir()
    Application.ScreenUpdating = False
    Range("B2:BI12").Interior.ColorIndex = xlNone
    Range("B2:BI12").ClearContents
    For i = 2 To [BK65536].End(3).Row - 1
        If Range("BK" & i) > 0 Then
        Range(Cells(i, "B"), Cells(i, 1 + Cells(i, "BK"))).Interior.ColorIndex = 3
        Range("B" & i) = "1"
        End If
        If Range("BK" & i) > 1 Then
        Range("B" & i).AutoFill Destination:=Range(Cells(i, "B"), Cells(i, 1 + Cells(i, "BK"))), Type:=xlFillSeries
        End If
    Next i
    Application.ScreenUpdating = True
End Sub

Sayın Korhan Ayhan, evet mükemmel çalıştı, elinize sağlık, emek ve nezaketiniz için de teşekkür ederim, saygılarımla.