• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

mükerrer süz ve say

Durum
Üzgünüz bu konu cevaplar için kapatılmıştır...
K

kucukdunyam

Katılım
14 Ocak 2008
Mesajlar
176
Excel Vers. ve Dili
2010 türkçe
çoklu müşteri listesi var, listede aynı müşteri birden fazla satırda mevcut, kritere göre, kaç adet müşterinin olduğunu öğrenebilirmiyiz.


dosyanın içinde açıklamayı ekledim.
 

Ekli dosyalar

Son düzenleme:
Merhaba
Sorunuzu tam olarak anlamadım. Biraz daha açık anlatabilir misiniz_?
Dosya üzerinde açıklarsanız ayrıca nasıl bu değerleri bulduğunuzu da izah ederseniz yardımcı olmaya çalışırım.
 
Ay Bazında Raporla tuşunda zaten bir makro var,
ancak makro eksik, Tarih Tatanak Sayısı ve Ceza Tutarını getiriyor, Aynı zamanda müşterinin de kaç adet olduğunu saydırmasını istiyorum.
Ancak kritere göre bunu yapacak, Giriş Sayfasındaki verilerden bu değerleri buluyorum. B11 hücresine, giriş sayfasındaki A sütününda 01/11/2011 ve sonraki dolu hücreye kadar olan alan'ı kriter yapmak üzere, aynı alanın C sütünunda kaç Farklı Müşteri No var, bunu yazdırmak istiyorum.


ayrıca dosyanın içinde belirttim.
 
kucukdunyam' Alıntı:
Ay Bazında Raporla tuşunda zaten bir makro var,
ancak makro eksik, Tarih Tatanak Sayısı ve Ceza Tutarını getiriyor, Aynı zamanda müşterinin de kaç adet olduğunu saydırmasını istiyorum.
Ancak kritere göre bunu yapacak, Giriş Sayfasındaki verilerden bu değerleri buluyorum. B11 hücresine, giriş sayfasındaki A sütününda 01/11/2011 ve sonraki dolu hücreye kadar olan alan'ı kriter yapmak üzere, aynı alanın C sütünunda kaç Farklı Müşteri No var, bunu yazdırmak istiyorum.


ayrıca dosyanın içinde belirttim.
Genişletmek için tıkla ...

Merhaba
Her satırda tarih olmalı
Aylık Bazda rapor almak için
Kod: 
Option Explicit
Sub Aylık_Rapor_61()
Dim ts, kaplan, trabzonspor, hamsi As Date
Dim bordo, mavi
Set bordo = Sheets("GİRİŞ")
Set mavi = Sheets("İSTATİSTİK")
trabzonspor = MsgBox("Aylık Bazda Rapor Alıyorum", vbYesNo, "Onay")
If trabzonspor = vbNo Then Exit Sub
Application.ScreenUpdating = False
hamsi = Time
mavi.Range("A11:D" & Rows.Count).ClearContents
kaplan = 11
For ts = 4 To bordo.Cells(Rows.Count, "A").End(xlUp).Row
If WorksheetFunction.CountIf(bordo.Range("A4:A" & ts), _
bordo.Cells(ts, "A")) = 1 Then
mavi.Cells(kaplan, "A") = bordo.Cells(ts, "A")
kaplan = kaplan + 1
End If
Next
kaplan = 0
For trabzonspor = 11 To mavi.Cells(Rows.Count, "A").End(xlUp).Row
bordo.Range("J:J").ClearContents
For ts = 4 To bordo.Cells(Rows.Count, "A").End(xlUp).Row
If Format(bordo.Cells(ts, "A"), "dd.mm.yyyy") = Format(mavi.Cells _
(trabzonspor, "A"), "dd.mm.yyyy") Then
bordo.Cells(ts, "J") = bordo.Cells(ts, "C") & " " & bordo.Cells(ts, "D")
End If
Next
For ts = 4 To bordo.Cells(Rows.Count, "J").End(xlUp).Row
If WorksheetFunction.CountIf(bordo.Range("J4:J" & ts), bordo.Cells(ts, "J")) = 1 Then
kaplan = kaplan + 1
mavi.Cells(trabzonspor, "B") = kaplan
End If
Next
bordo.Range("J:J").ClearContents
mavi.Cells(trabzonspor, "C") = WorksheetFunction.CountIf(bordo.Range("A:A"), _
mavi.Cells(trabzonspor, "A"))
mavi.Cells(trabzonspor, "D") = WorksheetFunction.SumIf(bordo.Range("A:A"), _
mavi.Cells(trabzonspor, "A"), bordo.Range("H:H"))
Next
Application.ScreenUpdating = True
MsgBox Format(hamsi - Time, "hh:mm:ss") & vbLf _
& "Sürede Aylık Bazda Rapor Aldım", , "Bitiş"
End Sub
Sekötür Bazında rapor almak için
Kod: 
Option Explicit
Sub sektör_bazında_61()
Dim ts, kaplan, trabzonspor, hamsi As Date
Dim bordo, mavi
Set bordo = Sheets("GİRİŞ")
Set mavi = Sheets("İSTATİSTİK")
trabzonspor = MsgBox("Sektör Bazda Rapor Alıyorum", vbYesNo, "Onay")
If trabzonspor = vbNo Then Exit Sub
Application.ScreenUpdating = False
hamsi = Time
mavi.Range("F11:I" & Rows.Count).ClearContents
kaplan = 11
For ts = 4 To bordo.Cells(Rows.Count, "F").End(xlUp).Row
If WorksheetFunction.CountIf(bordo.Range("F4:F" & ts), _
bordo.Cells(ts, "F")) = 1 Then
mavi.Cells(kaplan, "F") = bordo.Cells(ts, "F")
kaplan = kaplan + 1
End If
Next
kaplan = 0
For trabzonspor = 11 To mavi.Cells(Rows.Count, "F").End(xlUp).Row
bordo.Range("J:J").ClearContents
For ts = 4 To bordo.Cells(Rows.Count, "A").End(xlUp).Row
If bordo.Cells(ts, "F") = mavi.Cells(trabzonspor, "F") Then
bordo.Cells(ts, "J") = bordo.Cells(ts, "C") & " " & bordo.Cells(ts, "D")
End If
Next
For ts = 4 To bordo.Cells(Rows.Count, "J").End(xlUp).Row
If WorksheetFunction.CountIf(bordo.Range("J4:J" & ts), bordo.Cells(ts, "J")) = 1 Then
kaplan = kaplan + 1
mavi.Cells(trabzonspor, "G") = kaplan
End If
Next
bordo.Range("J:J").ClearContents
mavi.Cells(trabzonspor, "H") = WorksheetFunction.CountIf(bordo.Range("F:F"), _
mavi.Cells(trabzonspor, "F"))
mavi.Cells(trabzonspor, "I") = WorksheetFunction.SumIf(bordo.Range("F:F"), _
mavi.Cells(trabzonspor, "F"), bordo.Range("H:H"))
Next
Application.ScreenUpdating = True
MsgBox Format(hamsi - Time, "hh:mm:ss") & vbLf _
& "Sürede Sektör Bazda Rapor Aldım", , "Bitiş"
End Sub
 
evet işimi görecek gibi, çok teşekkür ederim, yalnız, Sekötür Bazında rapor almak kodunda, sadece birinci satırdaki sektörün müşteri sayısını veriyor, yani alt satırlardaki sektörün karşısını hesaplamıyor, onu da düzeltebilirmisiniz.
 
kucukdunyam' Alıntı:
evet işimi görecek gibi, çok teşekkür ederim, yalnız, Sekötür Bazında rapor almak kodunda, sadece birinci satırdaki sektörün müşteri sayısını veriyor, yani alt satırlardaki sektörün karşısını hesaplamıyor, onu da düzeltebilirmisiniz.
Genişletmek için tıkla ...

Hata aldığınız yeri işaretleyerek dosya ekler misiniz_?
 
hayır hata almıyorum, ancak Müşteri sayısını sadece G11 de hesaplıyor, G12-13-14 de getirmiyor.
 
kucukdunyam' Alıntı:
hayır hata almıyorum, ancak Müşteri sayısını sadece G11 de hesaplıyor, G12-13-14 de getirmiyor.
Genişletmek için tıkla ...

Bence sorun sizde çünkü bende müşteri sayısını çıkarıyor hem de gayet güzel bir şekilde.

Goruntu.JPG
 
Sub AYBAZINDARAPOR()
Dim S1 As Worksheet, S2 As Worksheet, X As Long, Y As Long
Dim İLK As Long, SON As Long, WF As WorksheetFunction
Dim Dizi As New Collection, Satır As Long, Son_Satır As Long

Application.ScreenUpdating = False
Set S1 = Sheets("GİRİŞ")
Set S2 = Sheets("İSTATİSTİK")
Set WF = WorksheetFunction

S2.Range("A11:C65536").ClearContents
İLK = 4
Satır = 11
Son_Satır = S1.Cells(Rows.Count, 2).End(3).Row

For X = 4 To Son_Satır
If X = Son_Satır Then
SON = X
Satır = Satır + 1
End If
If IsDate(S1.Cells(X, 1)) Then
S2.Cells(Satır, 1) = S1.Cells(X, 1)
Satır = Satır + 1
If X > İLK Then
SON = X - 1
On Error Resume Next
For Y = İLK To SON
Dizi.Add CStr(S1.Cells(Y, 2))
Next
S2.Cells(Satır - 2, 2) = 'buraya Dizi.Count değerinin mükerrer olmayanlarını yani, farklı müşteri sayısını yazdırıcaz
S2.Cells(Satır - 2, 3) = Dizi.Count
S2.Cells(Satır - 2, 4) = WF.SumIf(S1.Range("B" & İLK & ":B" & SON), "<>""", S1.Range("H" & İLK & ":H" & SON))
Set Dizi = Nothing
İLK = SON + 1
End If
ElseIf X = SON Then
On Error Resume Next
For Y = İLK To SON
Dizi.Add CStr(S1.Cells(Y, 2))
Next
S2.Cells(Satır - 2, 2) = 'buraya Dizi.Count değerinin mükerrer olmayanlarını yani, farklı müşteri sayısını yazdırıcaz
S2.Cells(Satır - 2, 3) = Dizi.Count
S2.Cells(Satır - 2, 4) = WF.SumIf(S1.Range("B" & İLK & ":B" & SON), "<>""", S1.Range("H" & İLK & ":H" & SON))
Set Dizi = Nothing
İLK = SON
End If
Next

Set S1 = Nothing
Set S2 = Nothing
Set WF = Nothing

Application.ScreenUpdating = True
End Sub


birinci yazdığınız kodun işlevi ile ilgili de elimde bir kod var yani, tarihleri yazmadan bu kod işimi görüyor ancak, eksiğim var, eksiğini de kodun içerisine yazdım? eksik kodu tamamlayabilirmiyiz
 
kucukdunyam' Alıntı:
Sub AYBAZINDARAPOR()
Dim S1 As Worksheet, S2 As Worksheet, X As Long, Y As Long
Dim İLK As Long, SON As Long, WF As WorksheetFunction
Dim Dizi As New Collection, Satır As Long, Son_Satır As Long

Application.ScreenUpdating = False
Set S1 = Sheets("GİRİŞ")
Set S2 = Sheets("İSTATİSTİK")
Set WF = WorksheetFunction

S2.Range("A11:C65536").ClearContents
İLK = 4
Satır = 11
Son_Satır = S1.Cells(Rows.Count, 2).End(3).Row

For X = 4 To Son_Satır
If X = Son_Satır Then
SON = X
Satır = Satır + 1
End If
If IsDate(S1.Cells(X, 1)) Then
S2.Cells(Satır, 1) = S1.Cells(X, 1)
Satır = Satır + 1
If X > İLK Then
SON = X - 1
On Error Resume Next
For Y = İLK To SON
Dizi.Add CStr(S1.Cells(Y, 2))
Next
S2.Cells(Satır - 2, 2) = 'buraya Dizi.Count değerinin mükerrer olmayanlarını yani, farklı müşteri sayısını yazdırıcaz
S2.Cells(Satır - 2, 3) = Dizi.Count
S2.Cells(Satır - 2, 4) = WF.SumIf(S1.Range("B" & İLK & ":B" & SON), "<>""", S1.Range("H" & İLK & ":H" & SON))
Set Dizi = Nothing
İLK = SON + 1
End If
ElseIf X = SON Then
On Error Resume Next
For Y = İLK To SON
Dizi.Add CStr(S1.Cells(Y, 2))
Next
S2.Cells(Satır - 2, 2) = 'buraya Dizi.Count değerinin mükerrer olmayanlarını yani, farklı müşteri sayısını yazdırıcaz
S2.Cells(Satır - 2, 3) = Dizi.Count
S2.Cells(Satır - 2, 4) = WF.SumIf(S1.Range("B" & İLK & ":B" & SON), "<>""", S1.Range("H" & İLK & ":H" & SON))
Set Dizi = Nothing
İLK = SON
End If
Next

Set S1 = Nothing
Set S2 = Nothing
Set WF = Nothing

Application.ScreenUpdating = True
End Sub


birinci yazdığınız kodun işlevi ile ilgili de elimde bir kod var yani, tarihleri yazmadan bu kod işimi görüyor ancak, eksiğim var, eksiğini de kodun içerisine yazdım? eksik kodu tamamlayabilirmiyiz
Genişletmek için tıkla ...

Siz tarihleri elle mi girmek istiyodunuz Onu söyleyin ben kendimin olmayan kodlarla oynama yapmıyorum. Tarihleri siz yazacaksanız üstteki kodu güncelliyeyim ona göre siz de çalıştırın.
 
kucukdunyam' Alıntı:
evet tarihleri elle giriyorum,
Genişletmek için tıkla ...

Bunu baştan söyleseydiniz kodu ona göre yazardım.
Kod: 
Option Explicit
Sub Aylık_Rapor_61()
Dim ts, kaplan, trabzonspor, hamsi As Date
Dim bordo, mavi
Set bordo = Sheets("GİRİŞ")
Set mavi = Sheets("İSTATİSTİK")
trabzonspor = MsgBox("Aylık Bazda Rapor Alıyorum", vbYesNo, "Onay")
If trabzonspor = vbNo Then Exit Sub
Application.ScreenUpdating = False
hamsi = Time
mavi.Range("B11:D" & Rows.Count).ClearContents
kaplan = 0
For trabzonspor = 11 To mavi.Cells(Rows.Count, "A").End(xlUp).Row
bordo.Range("J:J").ClearContents
For ts = 4 To bordo.Cells(Rows.Count, "A").End(xlUp).Row
If Format(bordo.Cells(ts, "A"), "dd.mm.yyyy") = Format(mavi.Cells _
(trabzonspor, "A"), "dd.mm.yyyy") Then
bordo.Cells(ts, "J") = bordo.Cells(ts, "C") & " " & bordo.Cells(ts, "D")
End If
Next
For ts = 4 To bordo.Cells(Rows.Count, "J").End(xlUp).Row
If WorksheetFunction.CountIf(bordo.Range("J4:J" & ts), bordo.Cells(ts, "J")) = 1 Then
kaplan = kaplan + 1
mavi.Cells(trabzonspor, "B") = kaplan
End If
Next
bordo.Range("J:J").ClearContents
mavi.Cells(trabzonspor, "C") = WorksheetFunction.CountIf(bordo.Range("A:A"), _
mavi.Cells(trabzonspor, "A"))
mavi.Cells(trabzonspor, "D") = WorksheetFunction.SumIf(bordo.Range("A:A"), _
mavi.Cells(trabzonspor, "A"), bordo.Range("H:H"))
Next
Application.ScreenUpdating = True
MsgBox Format(hamsi - Time, "hh:mm:ss") & vbLf _
& "Sürede Aylık Bazda Rapor Aldım", , "Bitiş"
End Sub
 
özür dilerim sayın hemşerim, farketmeden eski dosyayı koymuşum, sizin kodunuzun olduğu dosya burda yani şimdi güncelledim. dosyayı çalıştırıyorum ama sonuçları getirmiyor, estf. kodunuzu beğenmemek gibi bir lüksümüz olamaz, aksine bordo mavi daha anlaşılır olmuş, sıfırdan kod yazmaktansa daha kolay değişiklik yaparsınız diye düşünmüştüm,
 

Ekli dosyalar

Son düzenleme:
kucukdunyam' Alıntı:
Merhabalar,
ya dünkü koda takıldım, dün uygulama fırsatım olmamıştı, bugün denedim olmadı, tekrar yardımcı olabilirseniz çok sevinirim.
Genişletmek için tıkla ...

Benim gönderdiğim kodu kullanmıyacaksanız bana niye ısrarla soruyorsunuz.
Onu anlamadım. Sorunuza çözüm buldum ve kodu gönderdim inadınıza aynı kodu kullanamaya devam ediyorsunuz. Kodu beğenmediyseniz o zaman anlarım.
 
özür dilerim sayın hemşerim, farketmeden eski dosyayı koymuşum, sizin kodunuzun olduğu dosya burda yani şimdi güncelledim. dosyayı çalıştırıyorum ama sonuçları getirmiyor, estf. kodunuzu beğenmemek gibi bir lüksümüz olamaz, aksine bordo mavi daha anlaşılır olmuş, sıfırdan kod yazmaktansa daha kolay değişiklik yaparsınız diye düşünmüştüm,
 

Ekli dosyalar

kucukdunyam' Alıntı:
özür dilerim sayın hemşerim, farketmeden eski dosyayı koymuşum, sizin kodunuzun olduğu dosya burda yani şimdi güncelledim. dosyayı çalıştırıyorum ama sonuçları getirmiyor, estf. kodunuzu beğenmemek gibi bir lüksümüz olamaz, aksine bordo mavi daha anlaşılır olmuş, sıfırdan kod yazmaktansa daha kolay değişiklik yaparsınız diye düşünmüştüm,
Genişletmek için tıkla ...

Merhaba
Her satırda tarih olmalı diye söylemiştim atlamışsınız.
Satırları tarih ile doldurun sonra deneyin. Yok ben boş olmasını istiyorum derseniz o zaman başka çözümler bulmak gerek.
 
s.a hepinize hayırlı cumalar.
belki bu açılan konunun dışında bi konu olabilir ama nereye yazacağımı bilemediğim için buraya yazıyorum kusura bakmayın lütfen.
iki konuda yardımlarınıza ihtiyac duydum ilgilenirseniz minnettar kalcağım sizlere.
 
Durum
Üzgünüz bu konu cevaplar için kapatılmıştır...
Geri
Üst