Dolgu rengi yada fonta göre toplama

hsayar · 20 Ekim 2007

Function BiçimTopla (Aralık, fontindex, dolguindex)
Aralık = mesala a11:a45
fontindex mesala = 2 (beyaz)
interior(dolguindex) ) = 15 (%25 gri)

a11:a45 aralığındaki %25 gri zemin ve beyaz yazı ile yazılmış rakamların toplamını almak isityorum.

ancak dolgu rengi kırmızı, font rengi siyah da olabilir veya dolgu otomatik, font otomatik olur bunlarıda hazır fonksiyonda ben seçecem.

Yardımcı olurmusunuz

Sorun çözmemde ayrdımcı olan @Ali Hocama teşekkür ederim
[quate]

hsayar' Alıntı:
tetiklemiyor zaten hocam ben zaten günlükten tsbye dağıtım yapıyordum çzöümü şu şekilde buldum

İlgili sayfada bir command buton tanımladım (daha doğrusu oraya bağlayacam) modüldeki adını yazdım

Kod:

Private Sub CommandButton1_Click() test End Sub

modül sayfasına fonksiyon ve kodları yazdım

Kod:

Function brdrenktopla(Adres As Range, Dolgu_rengi, Font_rengi, islem As Integer) Dim c As Range On Error Resume Next Toplam = 0 If islem = 1 Then For Each c In Adres If c.Interior.ColorIndex = Dolgu_rengi And c.Font.ColorIndex = Font_rengi And c <> "" Then Toplam = Toplam + c.Value Next End If brdrenktopla = Toplam End Function Sub test() Set S2 = Sheets("tsb") S2.Cells(13, 3) = brdrenktopla(S2.[C4:C11], 1, 2, 1) 'alış End Sub

İlgili Yeni Sorular:

Kod:

    Selection.Interior.ColorIndex = xlNone
    Selection.Font.ColorIndex = 0

1) durumunu nasıl toplatacağız hocam ilgili yerelere xlnone,0 yazdım ama işe yaramadı
2) herhangi bir renk ile işaretlenmiş hücreleri aynı anda toplama imkanı varmı
3) İşlem tipi 1 demişsiniz toplamak için peki işlem tipi = 2 için sayma işelmi atamak için nereye ne ilave edeceğiz.
4) Kullanıcı tanımlı fonsiyonlara yardım eklenebilirmi

Merhum İdris SERDAR · 20 Ekim 2007

http://www.excel.web.tr/showthread.php?t=21881
http://www.excel.web.tr/showthread.php?t=21881

Buradaki dosyaları inceleyin.

.

Orion1 · 20 Ekim 2007

Ekli dosyayı inceleyiniz.
Formülde Aralık;Fontindex;Dolguindex giriyorsunuz.:

Kod:

Function BiçimTopla(Aralık, fontindex, dolguindex)
Dim hucre As Range, fonttopla As Long, dolgutopla As Long
For Each hucre In Aralık
    If hucre.Font.ColorIndex = fontindex Then
        fonttopla = fonttopla + 1
    End If
    If hucre.Interior.ColorIndex = dolguindex Then
        dolgutopla = dolgutopla + 1
    End If
    BiçimTopla = "FontIndex= " & fonttopla & " DolguIndex= " & dolgutopla
Next
End Function

Ali · 20 Ekim 2007

hsayar' Alıntı:
ancak dolgu rengi kırmızı, font rengi siyah da olabilir veya dolgu otomatik, font otomatik olur bunlarıda hazır fonksiyonda ben seçecem.

Yardımcı olurmusunuz

Aşağıdaki linkide inceleyebilirsiniz.

Renkli zemin ve Font Özelliklerine Göre Uygulamalar

hsayar · 20 Ekim 2007

Orion2' Alıntı:

Ekli dosyayı inceleyiniz.
Formülde Aralık;Fontindex;Dolguindex giriyorsunuz.:

Kod:

Function BiçimTopla(Aralık, fontindex, dolguindex)
Dim hucre As Range, fonttopla As Long, dolgutopla As Long
For Each hucre In Aralık
    If hucre.Font.ColorIndex = fontindex Then
        fonttopla = fonttopla + 1
    End If
    If hucre.Interior.ColorIndex = dolguindex Then
        dolgutopla = dolgutopla + 1
    End If
    BiçimTopla = "FontIndex= " & fonttopla & " DolguIndex= " & dolgutopla
Next
End Function

@odion hocam saymıyacam toplayacam anlatamadım herhalde

@Ali ve @yurttas hocam
o linkleri sabahleyin baktım ama sadece font rengine göre toplama vardı

Ayrıca ColorSum lu bir fonsiyon vardı taslak sayfasında kullandım ve taslak makro ile doldurulunca kodlar işlemiyor her seferinde f9 basmak lazım geliyor

aktarma işlmei bittikjtan sonra hadi kendi yapsın diye sayfayı seçtirip calculete yazıyorum gene çalışmıyor

Ali · 20 Ekim 2007

Sn hsayar verdiğim linkte

Font rengine göre var,Dolgu rengine göre var, Kalın,italik ve altı çizgili olana göre var.

Renge göre toplam adlı sayfa dolgu rengine göre;
Fontagöretopla sayfa font rengine göre;
ZeminveFonta göre topla adlı sayfa tümünüde içerek şekilde (font rengi,dolgu rengi ,Kalın,italik ve altı çizgili ..) toplam alır.

hsayar · 20 Ekim 2007

@Ali Hocam

Kod:

Function Bicimegoretopla(Referanshucre As Range, Aral&#305;k As Range)
Dim rhucre As Range
Dim Kac&#305;nc&#305; As Boolean
Dim Sonuc

 For Each rhucre In Aral&#305;k
    With rhucre
        Kac&#305;nc&#305; = (Referanshucre.Interior.ColorIndex = _
        .Interior.ColorIndex And _
        Referanshucre.Font.ColorIndex = _
        .Font.ColorIndex And _
        Referanshucre.Font.Bold = _
        .Font.Bold And _
        Referanshucre.Font.Italic = _
        .Font.Italic And _
        Referanshucre.Font.Underline = .Font.Underline)
   End With
         If Kac&#305;nc&#305; = True Then
            Sonuc = WorksheetFunction.Sum(rhucre) + Sonuc
         End If
 Next rhucre

Bicimegoretopla = Sonuc
End Function

Referans hücre vermeden tüm biçim özelliklerini Sayısal girmek isityorum
(Beyaz Font için 2) (%25 gri için 15) (font tipi için kalın, italik, normal ne girilmesi gerekiyorsa) fonkisyon içinde ben girecem

ve eğer dolgurengi, fontrengi, fonttipi değerlerinden bir boş ise excelin default değeri olarak kabul etmesini istiyorum

hsayar · 20 Ekim 2007

Kod:

Function Renktopla(Aral&#305;k As Range, Renk&#304;ndeksi As Integer, _
    Optional Dolgu&#304;ndeksi As Boolean = False) As Double

Dim rng As Range
Dim OK As Boolean

Application.Volatile True
For Each rng In Aral&#305;k.Cells
    If Dolgu&#304;ndeksi = True Then
        OK = (rng.Font.ColorIndex = Renk&#304;ndeksi)
    Else
        OK = (rng.Interior.ColorIndex = Renk&#304;ndeksi)
    End If
    If OK And IsNumeric(rng.Value) Then
        Renktopla = Renktopla + rng.Value
    End If
Next rng
End Function

@Ali Hocam istediğim tam olarak bu ancak şöyle bir sorun var mevcur zemin rengim siyah ve dolgu rengim beyaz

ben bir hücrenin dolgu rengini kırmızı iken siyah yaptım diyelim...
gittim kırmızıya çevirdim toplam değişmiyor F9 u tuşluyorum öyle yapıyor
bunun çzümü ne peki

Orion1 · 20 Ekim 2007

hsayar' Alıntı:
@odion hocam saymıyacam toplayacam anlatamadım herhalde

Ekli dosyayı inceleyiniz.

Kod:

Function BiçimTopla(Aralık, fontindex, dolguindex)
Dim hucre As Range, fonttopla As Single, dolgutopla As Single
For Each hucre In Aralık
    If hucre.Font.ColorIndex = fontindex Then
        fonttopla = fonttopla + hucre.Value
    End If
    If hucre.Interior.ColorIndex = dolguindex Then
        dolgutopla = dolgutopla + hucre.Value
    End If
    BiçimTopla = "FontIndex= " & fonttopla & " DolguIndex= " & dolgutopla
Next
End Function

Ali · 20 Ekim 2007

Kod:

Function renktopla(Adres As Range, Dolgu_rengi, Font_rengi, islem As Integer)
Dim c As Range
On Error Resume Next
Toplam = 0
If islem = 1 Then
    For Each c In Adres
       If c.Interior.ColorIndex = Dolgu_rengi And c.Font.ColorIndex = Font_rengi And c <> "" Then Toplam = Toplam + c.Value
       Next
End If
renktopla = Toplam
End Function

Sarı zeminli, kırmızı fontlu olan için

=renktopla(A1:A15;6;3;1) yazınız.

Ali · 20 Ekim 2007

hsayar' Alıntı:

Kod:

@Ali Hocam istediğim tam olarak bu ancak şöyle bir sorun var mevcur zemin rengim siyah ve dolgu rengim beyaz
 
ben bir hücrenin dolgu rengini kırmızı iken siyah yaptım diyelim...
gittim kırmızıya çevirdim toplam değişmiyor F9 u tuşluyorum öyle yapıyor
bunun çzümü ne peki[/quote]
 
 
Sn hsayar,bildiğim kadarı ile font ve zemin renginin değişimi sayfadaki change olayını tetiklemiyor o nedenle calculate olayı gerçekleşince( yani sizin yaptığınız gibi F9 tuşuna basmak) çalışıyor.

hsayar · 20 Ekim 2007

Ali hocam ben mesajı editledim gerçi ama siz konuyla ilgilenmişsiniz.

ben bir hücrenin dolgu rengini kırmızı iken siyah yaptım diyelim...
gittim kırmızıya çevirdim toplam değişmiyor F9 u tuşluyorum öyle yapıyor
bunun çzümü ne pek

Orion1 · 20 Ekim 2007

hsayar' Alıntı:
ben bir hücrenin dolgu rengini kırmızı iken siyah yaptım diyelim...
gittim kırmızıya çevirdim toplam değişmiyor F9 u tuşluyorum öyle yapıyor
bunun çzümü ne pek.

Ali' Alıntı:
Sn hsayar,bildiğim kadarı ile font ve zemin renginin değişimi sayfadaki change olayını tetiklemiyor o nedenle calculate olayı gerçekleşince( yani sizin yaptığınız gibi F9 tuşuna basmak) çalışıyor.

______________________________________________

hsayar · 20 Ekim 2007

tamam ben bu işlemi Günlük sayfasındaki a ve b kolanlarında uygun değerelere göre tsb sayfasına aktarıyorum
mesala

a kolonunda 12 ve b kolonunda p olanları
tsb sayfasının a,b,e kolonlarına aktarıyorum
a kolonunda 12 ve b kolonunda v olanları
tsb sayfasının a,b,e kolonlarına aktarıyorum
dolgu rengini siyah fontu beyaz yapıyorum

işlemler bittiğinde kodların altına calculete yazıyorum

yine hesaplamıyor

tsb sayfasının en altında e45 te veresiye olanlar yani dolgusu siyah fontu beyaz olanları topla fonksiyonu standart olarak yazılı veriler aktarılaınca sanki ben ona özel topla dememişimde ne varsa topla demişişim gibi e11:e44 aralığını topluyor

birazdan tsb sayfasına makro ile değeri yazdırmayı deneyecem calculete anlamını yitirecek bu durumda bakalım.

Ali · 20 Ekim 2007

Hangi sayfada iseniz o sayfanın kodunun içine

Kod:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Calculate
End Sub

yazınız.

Bu durumda kullanıcı tanımlı fonsiyonunuz siz değiştirdiğinizde çalışacaktır.

Not:Font rengini tetiklerken, dolgu rengini tetiklemeyebilir.

hsayar · 20 Ekim 2007

tetiklemiyor zaten hocam ben zaten günlükten tsbye dağıtım yapıyordum çzöümü şu şekilde buldum

İlgili sayfada bir command buton tanımladım (daha doğrusu oraya bağlayacam) modüldeki adını yazdım

Kod:

Private Sub CommandButton1_Click()
test
End Sub

modül sayfasına fonksiyon ve kodları yazdım

Kod:

Function brdrenktopla(Adres As Range, Dolgu_rengi, Font_rengi, islem As Integer)
Dim c As Range
On Error Resume Next
Toplam = 0
If islem = 1 Then
    For Each c In Adres
       If c.Interior.ColorIndex = Dolgu_rengi And c.Font.ColorIndex = Font_rengi And c <> "" Then Toplam = Toplam + c.Value
    Next
End If
brdrenktopla = Toplam
End Function
Sub test()
Set S2 = Sheets("tsb")
S2.Cells(13, 3) = brdrenktopla(S2.[C4:C11], 1, 2, 1) 'al&#305;&#351;
End Sub

Ancak default olan değerler olna dolguyok ve otomatih hücre rengi için nasıl olacak onuda söylerseniz sevinirim.

Kod:

    Selection.Interior.ColorIndex = xlNone
    Selection.Font.ColorIndex = 0

durmunu nasıl toplatacağız hocam
ilgili yerelere xlnone,0 yazdım ama işe yaramadı

hsayar · 20 Ekim 2007

üstteki mesaj düzeltilmiştir.
renk değiştiğinde toplamın hesaplaması sorunu çözülmüştür.
font ve dolgu rekleri otamatik iken nasıl olacak sorusu nasıl olacak veya şöyle sorayım
font veya zemin rengi otomatik değilde herhani bir yani index değeri 1>= ve <=56 diye girebilirmiyiz. galiba buda bir yöntem ama nasıl ?
bu arada kt fonkssiyonumuda koyukırmız yani 9 değerini toplamıyor tedadüfen deneyeyim dedi.. .aslında lazım değil ama bilginiz olsun bana siyah,beyaz,kırmızı,gr, yeter siyah beyazı denedim

bir soruda bu forumda bir yeri kırmızı yazmak istersem nasıl olacak

Necdet · 21 Ekim 2007

Aşağıdaki linki de anımsatayım

http://www.excel.web.tr/showthread.php?t=34042&highlight=kullan%FDc%FD+tan%FDml%FD+fonksiyon

hsayar · 22 Ekim 2007

Sn necdet hocam sizin kodlarınız vastası ile sorunumu bir şekilde çözdüm
Örnek hücrede istediğim değeri öğrendim önce (sizn fonksiyondan uyarlama

)

Kod:

Public Function ozellik(Ornek_Hucre)
FontRengi = Ornek_Hucre.Font.ColorIndex
DolguRengi = Ornek_Hucre.Interior.ColorIndex
ozellik = "fontrengi= " & FontRengi & " / dolgurengi= " & DolguRengi
End Function

sonuç olarak
Dolgu Rengi Otomatik ve font rengi otomatik ise index değerlerinin aşağıdaki gibi olduğunu öğrendim

fontrengi= -4105 / dolgurengi= -4142

Kod:

Function brdrenktopla(Adres As Range, Dolgu_rengi, Font_rengi, islem As Integer)
Dim c As Range
On Error Resume Next
Toplam = 0
If islem = 1 Then
    For Each c In Adres
       If c.Interior.ColorIndex = Dolgu_rengi And c.Font.ColorIndex = Font_rengi And c <> "" Then Toplam = Toplam + c.Value
    Next
End If
brdrenktopla = Toplam
End Function

fonksiyonunda ilgili alanlara yazınca sorun ortadan kalktı siz çakmağı çakdınız sağolun...

ASMET67 · 23 Kasım 2017

Dosya silinmiş elinde olan varmıı

Dolgu rengi yada fonta göre toplama

hsayar

Merhum İdris SERDAR

Moderatör

Orion1

Uzman

Ali

Özel Üye

hsayar

Ali

Özel Üye

hsayar

hsayar

Orion1

Uzman

Ali

Özel Üye

Ali

Özel Üye

hsayar

Orion1

Uzman

hsayar

Ali

Özel Üye

hsayar

hsayar

Necdet

Moderatör

hsayar

ASMET67

Dolgu rengi yada fonta g&#246;re toplama

Moderatör

Uzman

Özel Üye

Özel Üye

Uzman

Özel Üye

Özel Üye

Uzman

Özel Üye

Moderatör

Dolgu rengi yada fonta göre toplama