Koşula Göre Benzersizleri Sayma

[turanb]

Merhabalar,

Ekteki Çalışma kitabını Veri Sayfası olarak düşünelim. Veri (satısay) Çalışma Sayfasının bulunduğu Aynı Klasörde başka bir çalışma kitabına(ismi RAPOR olsun),

B sütunundaki isimlerden birini kod içinde tanımladığımda sadece o isimlerin bulunduğu satırdaki E hücresinde bulunan müşterileri benzersiz olarak sayarak mesela A36 hücresine yazsın.

Dosyam ektedir.

http://www.dosya.tc/server22/ZfIpaD/sat_rsay.xlsx.html

Not: Makro ile rica ediyorum.

Teşekkür ederim.

 

[turanb]

Örneğin aşağıdaki kodun içine benzersiz sayacak kodu yerleştirebilir miyiz.

Private Sub CommandButton1_Click()
    Dim DosyaYoluAdi As String
    Dim Syf As Worksheet
    Dim Dosya As Workbook
    
    DosyaYoluAdi = "C:\Users\term\Desktop\Makro Raporlar\Veri.xls"
    Set Dosya = Workbooks.Open(DosyaYoluAdi)
    Set Syf = Dosya.Sheets("Sayfa1")
    
    For i = 3 To Syf.Cells(Rows.Count, "A").End(3).Row
        If Syf.Range("E" & i) = "CH Ödeme" Then
            chodeme = chodeme + Syf.Range("H" & i)
        End If
        
    Next
    ThisWorkbook.Sheets("Sayfa2").Range("B3").Value = chodeme
    
    Dosya.Close False
End Sub

chodeme = chodeme + Syf.Range("H" & i) bu satırın yerine benzersiz sayma işlemi yapabilir miyiz.

 

[cengizank]

Sheets("Sayfa1"").Select
Range("A2:O30").AdvancedFilter Action:=xlFilterInPlace, Unique:=True

Benzersiz kayıtlar için

 

[turanb]

Sheets("Sayfa1"").Select
Range("A2:O30").AdvancedFilter Action:=xlFilterInPlace, Unique:=True

Benzersiz kayıtlar için

Sn. Cengizank Kodu yukarıdaki kodun yerine koymam yeterli mi?

 

[turanb]

Arkadaşlar forumda didik didik aradım benim problemini çözecek bir koda rastlamadım. Yada karmaşık olduğu için anlamadım anladıklarım ise sade saydırma.

Yardım edecek kimse yok mu.

 

[turanb]

Bir kod buldum uyarladım fakat ters giden birşeyler var. Sonuç 0 çıkıyor.

kodlamanın ciğerinden anlayan arkadaşlar bir inceleyebilir misiniz.

Private Sub CommandButton1_Click()

Dim sat As Long, i As Long, say As Long
Dim DosyaYoluAdi As String
    Dim Syf As Worksheet
    Dim Dosya As Workbook
    
    DosyaYoluAdi = "C:\Users\buradan açın\Desktop\raporlama\Veri.xls"
    Set Dosya = Workbooks.Open(DosyaYoluAdi)
    Set Syf = Dosya.Sheets("Sayfa1")
sat = Cells(Rows.Count, "e").End(xlUp).Row
For i = 1 To sat
    If Syf.Range("b" & i) = "ABDULLAH DEMİR" And WorksheetFunction.CountIf(Syf.Range("e3:e" & i), Syf.Cells(i, "e").Value) = 1 Then say = say + 1
Next
Range("a1").Value = say
 Dosya.Close False
End Sub

 

[mtncbk]

Merhabalar. Site adminlerinden birine nasıl ulaşabilirim acaba. Ücretli üyelik hakkında sorum olacaktı. Belki alakasız bir yer oldu özür dilerim.

 

[turanb]

Aramaya altın üyelik yaz. Hüseyin bey ilgileniyor. oradan irtibat kurabilirsin.

 

[mtncbk]

Bilgi için teşekkürler turanb. Ödeme yaptım üyelik aktifleştirmek için irtibat kurmak istiyorum aslında.

 

[turanb]

Size gelen mailden ulaşabilirsiniz.

 

[turanb]

Hüseyin çoban bey uyarmanız gerektiğinde görüyorsunuz. Kaç gündür uğraşıyorum yardım etmek için neden görmüyorsunuz???

 

[cengizank]

Bir kod buldum uyarladım fakat ters giden birşeyler var. Sonuç 0 çıkıyor.

kodlamanın ciğerinden anlayan arkadaşlar bir inceleyebilir misiniz.

Private Sub CommandButton1_Click()

Dim sat As Long, i As Long, say As Long
Dim DosyaYoluAdi As String
    Dim Syf As Worksheet
    Dim Dosya As Workbook
    
    DosyaYoluAdi = "C:\Users\buradan açın\Desktop\raporlama\Veri.xls"
    Set Dosya = Workbooks.Open(DosyaYoluAdi)
    Set Syf = Dosya.Sheets("Sayfa1")
sat = Cells(Rows.Count, "e").End(xlUp).Row
For i = 1 To sat
    If Syf.Range("b" & i) = "ABDULLAH DEMİR" And WorksheetFunction.CountIf(Syf.Range("e3:e" & i), Syf.Cells(i, "e").Value) = 1 Then say = say + 1
Next
Range("a1").Value = say
 Dosya.Close False
End Sub

dosyanda

isimlerde

Abdullah Demir yok
sadece Abdullah var

bundan kaynaklanıyor olabilir

 

[turanb]

Sn. cengizank gerçek dosyamda ABDULLAH DEMİR yazıyor ama sonuç sıfır geliyor.

Acaba Veri Çalışma kitabını değil de kodun yazılı olduğu çalışma kitabını mı görüyor.

 

[cengizank]

iki dosyanın da ufak bir örneğini eklerseniz.
yardım etmeye çalışıyım.

fileupload sitelerine yükleyip. link eklerseniz sevinirim.

çünkü dosya indirme ve yükleme yetkim yok.

 

[Emir Hüseyin Çoban]

Hüseyin çoban bey uyarmanız gerektiğinde görüyorsunuz. Kaç gündür uğraşıyorum yardım etmek için neden görmüyorsunuz???

. . .

Dosyanız ektedir.

Ancak dikkatimi çeken bir kısım var.
Örneğin FATİH sonunda bir boşluk var. Siz arama kısmında bu boşluğuda yazmazsanız kodlar doğru sonuca ulaşamaz.

...::: Ekli Dosyayı İndirmek İçin Linki Tıklayınız :::...
http://yadi.sk/d/7DkA2YeMG6Bqi

. . .

 

[turanb]

Sn. Cengizank hocam,

Kodu evde çalışmıştım. Şimdi ofiste gerçek rapor tabloma göre girdim ve çalıştı.

Fakat bir sorun daha çıkacak gibi gözüküyor. 9 tane eleman var, her elemana farklı değişken nasıl atarım. yani yayınladığım kod da Abdullah demir e ait satırları sayıp onu A1 hücresine yazdırırken say değerini ya diyorum ya.
Aynı kod içerisinde farklı elemanlara değer vermeyi nasıl yapacam. say değerini bütün elemanlara verir isem problem olur sanırım.

Umarım anlatabilmişimdir.

 

[turanb]

Saygıdeğer arkadaşlarım emeğiniz için teşekkür ederim.

Sayın Hüseyin ve cengizank her ikinizinde kodlarını denedim. Tek eleman için çalışıyor. Ancak bir sıkıntı var.

Her eleman için ayrı bir buton yapıp bütün kodu her eleman için yeniden mi çalıştırmam gerekiyor. Bu çok uzun olur 9 tane eleman var.

Kodun içerisine tek buton ile her eleman için ayrı hesaplama yapabileceğim bir düzenleme mümkün müdür. Özellikle kısa olan koda yani mesaj içerisinde geçen koda bir düzenleme yaparsanız sevinirim.

Yardımlarınızı bekler teşekkür ederim...

Aşağıdaki hüseyin beyin yazdığı koda ilave yapayım dedim ama olmadı.

Private Sub CommandButton4_Click()
Application.ScreenUpdating = False
Dim DosyaYoluAdi As String
Dim Syf As Worksheet
Dim Dosya As Workbook

DosyaYoluAdi = ThisWorkbook.Path & "\POM.xlsx"
Set Dosya = Workbooks.Open(DosyaYoluAdi)

Dim Acik As Worksheet
Dim Kapali As Worksheet
Set Acik = Workbooks("RAPOR").Sheets("SİVAS")
Set Kapali = Workbooks("POM").Sheets("Sayfa1")
say = 0

'    Set Syf = Dosya.Sheets("Sayfa1")
'
'    For i = 3 To Syf.Cells(Rows.Count, "A").End(3).Row
'        If Syf.Range("E" & i) = "CH Ödeme" Then
'            chodeme = chodeme + Syf.Range("H" & i)
'        End If
'
'    Next
'    ThisWorkbook.Sheets("Sayfa2").Range("B3").Value = chodeme

For a = 2 To Kapali.[B65536].End(3).Row
If Acik.Range("P4") = Kapali.Cells(a, "B") Then

If WorksheetFunction.CountIf(Kapali.Range("E2:E" & a), Kapali.Cells(a, "E")) = 1 Then
c = c + 1
say = say + 1
apo = say
End If
End If
If Acik.Range("P5") = Kapali.Cells(a, "B") Then

If WorksheetFunction.CountIf(Kapali.Range("E2:E" & a), Kapali.Cells(a, "E")) = 1 Then
c = c + 1
say = say + 1
apo = say
End If
End If
Next
Acik.Range("r4") = fat
Acik.Range("r4") = apo

Dosya.Close False
Application.ScreenUpdating = True
MsgBox " B i t t i "
End Sub

 

[turanb]

. . .

Dosyanız ektedir.

Ancak dikkatimi çeken bir kısım var.
Örneğin FATİH sonunda bir boşluk var. Siz arama kısmında bu boşluğuda yazmazsanız kodlar doğru sonuca ulaşamaz.




. . .

Karakterler dikkat ediyorum. aynısını kopyalayıp yapıştırıyorum. Yaptığınız çalışmayı denedim çalışıyor fakat yine bir derdim var. 9 eleman var bunların isimleri tabloda yazıyor ve karşılarına da (örnek isimler P4,P5,P6, hücrelerinde sonuçlar ise R4,R5,R6 hücrelerine yazılacak) sonuçları yazması gerekiyor.
Kod u tek bir eleman için çalıştırabiliyorum fakat hepsine aynı anda uyarlayamadım.

 

[cengizank]

Sn. Cengizank hocam,

Kodu evde çalışmıştım. Şimdi ofiste gerçek rapor tabloma göre girdim ve çalıştı.

Fakat bir sorun daha çıkacak gibi gözüküyor. 9 tane eleman var, her elemana farklı değişken nasıl atarım. yani yayınladığım kod da Abdullah demir e ait satırları sayıp onu A1 hücresine yazdırırken say değerini ya diyorum ya.
Aynı kod içerisinde farklı elemanlara değer vermeyi nasıl yapacam. say değerini bütün elemanlara verir isem problem olur sanırım.

Umarım anlatabilmişimdir.

Ufak bir öneri bir hücrede değişkenleri belirtin.

VB kodunda eleman Abdullah Demir yazacağınıza hücredeki değeri okuma işlemi yapın


dosyaları indirdim ilk fırsatım da inceleyeceğim

 

[Emir Hüseyin Çoban]

Karakterler dikkat ediyorum. aynısını kopyalayıp yapıştırıyorum. Yaptığınız çalışmayı denedim çalışıyor fakat yine bir derdim var. 9 eleman var bunların isimleri tabloda yazıyor ve karşılarına da (örnek isimler P4,P5,P6, hücrelerinde sonuçlar ise R4,R5,R6 hücrelerine yazılacak) sonuçları yazması gerekiyor.
Kod u tek bir eleman için çalıştırabiliyorum fakat hepsine aynı anda uyarlayamadım.

. . .

Dosyanız ektedir.

...::: Ekli Dosyayı İndirmek İçin Linki Tıklayınız :::...
http://yadi.sk/d/ZBdDf4kZG6vfs

. . .