Excel Forum
ALTIN ÜYELİK Hakkında Bilgi


Geri Git   Excel Forum > EXCEL-Soruları > Makro-VBA
Atatürk
Şifremi Unuttum

DUYURU SİSTEMİ / REKLAM PANOSU

Makro-VBA Makro veya VBA ile ilgili sorularınızı buraya gönderebilirsiniz.
Dosya ekleyebilirsiniz

Özel Arama


Yanıtla
 
Paylaş Konu Araçları Görünüm Modları
Eski 18-05-2016, 13:01   #1
kadirdiloglu
 
Giriş: 29/10/2011
Şehir: rusya
Mesaj: 120
Excel Vers. ve Dili:
2007 türkçe
Varsayılan renkli hücre içindekileri toplama

Merhaba,

Sütun içindeki renkli hücrelerin içindeki verileri toplamak istiyorum. Nasıl yapabilirim?

Renkli hücreleri saydırmak için aşağıdaki makroyu kullanıyorum. ama içindeki sayıları toplamak için ne yapmalıyım?

Örnek dosya ; http://s2.dosya.tc/server/29hpzp/deneme7.zip.html

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Function DRSay(rhcr As Range, alns As Range)
Application.Volatile
Dim sut As Integer
Dim Thcr As Range
sut = rhcr.Interior.ColorIndex
For Each Thcr In alns
    If sut = Thcr.Interior.ColorIndex Then
        DRSay = DRSay + 1
    End If
Next Thcr
End Function

Bu mesaj en son " 18-05-2016 " tarihinde saat 15:27 itibariyle kadirdiloglu tarafından düzenlenmiştir....
kadirdiloglu Çevrimdışı   Alıntı Yaparak Cevapla
Eski 18-05-2016, 14:14   #2
dalgalikur
Destek Ekibi
 
dalgalikur kullanıcısının avatarı
 
Giriş: 04/06/2006
Mesaj: 1,118
Excel Vers. ve Dili:
2007-2013
Varsayılan

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Function DRSay(rhcr As Range, alns As Range)
Application.Volatile
Dim sut As Integer
Dim Thcr As Range
dim Toplam as double
sut = rhcr.Interior.ColorIndex
For Each Thcr In alns
    If sut = Thcr.Interior.ColorIndex Then
        DRSay = DRSay + 1
        toplam=toplam + thcr 
    End If
Next Thcr
End Function
dalgalikur Çevrimdışı   Alıntı Yaparak Cevapla
Eski 18-05-2016, 15:11   #3
kadirdiloglu
 
Giriş: 29/10/2011
Şehir: rusya
Mesaj: 120
Excel Vers. ve Dili:
2007 türkçe
Varsayılan

Alıntı:
dalgalikur tarafından gönderildi Mesajı Görüntüle
Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Function DRSay(rhcr As Range, alns As Range)
Application.Volatile
Dim sut As Integer
Dim Thcr As Range
dim Toplam as double
sut = rhcr.Interior.ColorIndex
For Each Thcr In alns
    If sut = Thcr.Interior.ColorIndex Then
        DRSay = DRSay + 1
        toplam=toplam + thcr 
    End If
Next Thcr
End Function
Bu makro da yukarıdaki sonucun aynısını veriyor yani sadece renkli hücreyi sayıyor
kadirdiloglu Çevrimdışı   Alıntı Yaparak Cevapla
Eski 18-05-2016, 15:20   #4
dalgalikur
Destek Ekibi
 
dalgalikur kullanıcısının avatarı
 
Giriş: 04/06/2006
Mesaj: 1,118
Excel Vers. ve Dili:
2007-2013
Varsayılan

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
dim Toplam as double
Function DRSay(rhcr As Range, alns As Range)
Application.Volatile
Dim sut As Integer
Dim Thcr As Range
sut = rhcr.Interior.ColorIndex
For Each Thcr In alns
    If sut = Thcr.Interior.ColorIndex Then
        DRSay = DRSay + 1
        toplam=toplam + thcr 
    End If
Next Thcr
End Function
şimdi "Toplam" değişkeninden toplam bilgisini alabilirsiniz.

Örnek:
msgbox toplam

Eğer yine yapamazsanız dosyanızı ekleyin üzerinde düzenleme yapayım.
dalgalikur Çevrimdışı   Alıntı Yaparak Cevapla
Eski 18-05-2016, 16:07   #5
dalgalikur
Destek Ekibi
 
dalgalikur kullanıcısının avatarı
 
Giriş: 04/06/2006
Mesaj: 1,118
Excel Vers. ve Dili:
2007-2013
Varsayılan

Module1 deki kodları silin aşağıdakileri kopyalayıp yapıştırın.

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Function DRSay(rhcr As Range, alns As Range)
    Application.Volatile
    Dim sut As Integer
    Dim Thcr As Range
    sut = rhcr.Interior.ColorIndex
    For Each Thcr In alns
        If sut = Thcr.Interior.ColorIndex Then
            DRSay = DRSay + 1
        End If
    Next Thcr
End Function

Function DRTopla(rhcr As Range, alns As Range)
    Application.Volatile
    Dim sut As Integer
    Dim Thcr As Range
    sut = rhcr.Interior.ColorIndex
    For Each Thcr In alns
        If sut = Thcr.Interior.ColorIndex Then
            DRTopla = DRTopla + Thcr
        End If
    Next Thcr
End Function
Toplama yapmak için =DRTopla fonksiyonunu kullanın.
dalgalikur Çevrimdışı   Alıntı Yaparak Cevapla
Eski 18-05-2016, 20:50   #6
kadirdiloglu
 
Giriş: 29/10/2011
Şehir: rusya
Mesaj: 120
Excel Vers. ve Dili:
2007 türkçe
Varsayılan

Alıntı:
dalgalikur tarafından gönderildi Mesajı Görüntüle
Module1 deki kodları silin aşağıdakileri kopyalayıp yapıştırın.

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Function DRSay(rhcr As Range, alns As Range)
    Application.Volatile
    Dim sut As Integer
    Dim Thcr As Range
    sut = rhcr.Interior.ColorIndex
    For Each Thcr In alns
        If sut = Thcr.Interior.ColorIndex Then
            DRSay = DRSay + 1
        End If
    Next Thcr
End Function

Function DRTopla(rhcr As Range, alns As Range)
    Application.Volatile
    Dim sut As Integer
    Dim Thcr As Range
    sut = rhcr.Interior.ColorIndex
    For Each Thcr In alns
        If sut = Thcr.Interior.ColorIndex Then
            DRTopla = DRTopla + Thcr
        End If
    Next Thcr
End Function
Toplama yapmak için =DRTopla fonksiyonunu kullanın.
teşekkürler işe yaradı..
kadirdiloglu Çevrimdışı   Alıntı Yaparak Cevapla
Eski 14-10-2017, 14:57   #7
bonoparte
 
Giriş: 16/12/2014
Şehir: Manisa
Mesaj: 14
Excel Vers. ve Dili:
MS Office 2013
Varsayılan

Merhaba,

Formül koşullu biçimlerde ile yapılan hücre renklendirmelerinde çalışmıyor. Nasıl bir değişiklik yapılabilir, yardımcı olabilirmisiniz.
bonoparte Çevrimdışı   Alıntı Yaparak Cevapla
Eski 14-10-2017, 23:39   #8
Korhan Ayhan
Moderatör
 
Korhan Ayhan kullanıcısının avatarı
 
Giriş: 15/03/2005
Şehir: ANTALYA
Mesaj: 22,643
Excel Vers. ve Dili:
OFFICE 2013-2016 PRO TR
Varsayılan

Koşullu biçimlendirme renklerini fonksiyonla saydıramazsınız. Bunun yerine genellikle koşullarınızı farklı formülere entegre edip saydırma ya da toplama işlevlerini tavsiye ediyoruz. Bunun dışında düz makro ile koşullu biçimlendirilmiş hücrelerin rengini saydırabilirsiniz.

Koşullu biçimlenmiş alanı seçip kodu çalıştırın. Kod kırmızı dolgu rengi olan hücreleri sayar.

Kod: (Rahat kopyalayabilmeniz için tüm kodu seçmenizi sağlar)
Sub RENK_SAY()
    Dim Veri As Range
    For Each Veri In Selection
        If Veri.DisplayFormat.Interior.ColorIndex = 3 Then Say = Say + 1
    Next
    Range("C1") = Say
End Sub
__________________
.
.
.

Soru sormadan önce forumumuzun aşağıdaki
bölümlerini incelediğinizde birçok sorunuza yanıt bulabilirsiniz.


Excel Dersanesi
Uygulamalı Excel Eğitimi
Excel İçin Örnek Uygulamalar
Video Dersane (***Altın Üyelere Özel***)

Lütfen sorularınızın çözümlendiğine dair geri dönüş mesajı yazınız...!
Lütfen yazım ve forum kurallarına uyalım...!
Lütfen sorularımızı açık ve net bir dille ifade edelim...!



FORUM KURALLARI
Korhan Ayhan Çevrimdışı   Alıntı Yaparak Cevapla
Yanıtla


Konu Araçları
Görünüm Modları

Gönderme Kuralları
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is Açık
SimgelerAçık
[IMG] kodu Açık
HTML kodu Kapalı


Saat 09:35


Bu forum Elit NET - www.elitnet.com.tr tarafından sunulmaktadır.

Excel Eğitimi - Mobil Uygulama - Çorlu - Çorlu Web Tasarım - Tarot Falı - invest in turkey - Lingerie - Dyeing Machine - Karton Bardak- Çorlu Özel Eğitim- Site Yönetimi- Led Aydınlatma- Pronet Tekirdağ- Çorlu Kamera- Pronet Edirne- Pronet Kırklareli- Pronet Çerkezköy- Pronet Çorlu- Pronet Lüleburgaz- Pronet Keşan- Çorlu Araç Takip- Çorlu Su Arıtma- Boru Profil- Gebze Emlak- Beylikdüzü Temizlik- İstanbul Burun Estetiği- Bakır Sülfat- Rampa- Rotary- Çorlu İnternet Sitesi- youngblood- Çorlu Palet- Çerkezköy Palet- Çorlu Prefabrik- Çorlu Sürücü Kursu- Çorlu Sandviç Panel- Şişli Avukat- Korona Test Kalemi- Çorlu Vinç- Çorlu Pimapen Tamiri- Çorlu Çelik Konstruksiyon-
Powered by vBulletin Version 3.7.2
Copyright ©2000 - 2017, Jelsoft Enterprises Ltd.
Advertisement System V2.6 By   Branden