mükerrer süz ve say

İhsan Tank · 18 Kasım 2011

kucukdunyam' Alıntı:
evet boş olması gerekiyor,
çünkü liste çooook uzun,

Merhaba
Bu kodu dener misiniz_?

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
For ts = 4 To bordo.Cells(Rows.Count, "B").End(xlUp).Row
If bordo.Cells(ts, "A") = "" Then
bordo.Cells(ts, "K") = bordo.Cells(ts - 1, "K")
Else
bordo.Cells(ts, "K") = bordo.Cells(ts, "A")
End If
Next
For trabzonspor = 11 To mavi.Cells(Rows.Count, "A").End(xlUp).Row
kaplan = 0
bordo.Range("J:J").ClearContents
For ts = 4 To bordo.Cells(Rows.Count, "K").End(xlUp).Row
If Format(bordo.Cells(ts, "K"), "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("K:K"), _
mavi.Cells(trabzonspor, "A"))
mavi.Cells(trabzonspor, "D") = WorksheetFunction.SumIf(bordo.Range("K:K"), _
mavi.Cells(trabzonspor, "A"), bordo.Range("H:H"))
Next
bordo.Range("K:K").ClearContents
Application.ScreenUpdating = True
MsgBox Format(hamsi - Time, "hh:mm:ss") & vbLf _
& "Sürede Aylık Bazda Rapor Aldım", , "Bitiş"
End Sub

kucukdunyam · 18 Kasım 2011

hocam deniyorum ama hiçbir sonuç gelmiyor, biryerlerde hata mı yapıyorum anlayamadım

İhsan Tank · 18 Kasım 2011

kucukdunyam' Alıntı:
hocam deniyorum ama hiçbir sonuç gelmiyor, biryerlerde hata mı yapıyorum anlayamadım

Merhaba

Kod:

İSTATİSTİK

Bu sayfaya tarih giriyor musunuz_?
Ben girdim ve denedim gayet güzel bilgileri getiriyor

kucukdunyam · 18 Kasım 2011

evet şimdi gördüm oldu, ancak, size yine zahmet vereceğim, tarihi de getirmesini sağlayabilirmisiniz,

İhsan Tank · 18 Kasım 2011

kucukdunyam' Alıntı:
hocam deniyorum ama hiçbir sonuç gelmiyor, biryerlerde hata mı yapıyorum anlayamadım

21. Mesajdaki kodda ufak bir değişiklik yaptım.

İhsan Tank · 18 Kasım 2011

kucukdunyam' Alıntı:
evet şimdi gördüm oldu, ancak, size yine zahmet vereceğim, tarihi de getirmesini sağlayabilirmisiniz,

Bunu anlamadım nasıl tarih gelecek. Dün tarih'i elle gireceğim demiştiniz.
Ayrıca Ay bazında rapor alacaksanız Giriş Sayfasında sadece o ayın kayıtları mı olacak yoksa başka ay kayıtlarıda olacak mı_? Başka ay kayıtları olacaksa siz bu tarihleri nasıl ayırt edeceksiniz_?

kucukdunyam · 18 Kasım 2011

denedim tarihi getirmedi

kucukdunyam · 18 Kasım 2011

istatistik sayfasındaki tarihleri, birinci sayfadan süzüp getirecek, ama Giriş sayfasındaki tarihleri ben elle giriyorum, bunu söylemek istemiştim,

kucukdunyam · 18 Kasım 2011

ay bazında derken, aslında gün bazında, yani bana sadece, gün gün kayıtları toplaması ve sayması yeterli olacak

kucukdunyam · 18 Kasım 2011

ihsan bey yoğunsunuz galiba,

İhsan Tank · 18 Kasım 2011

Merhaba
Bu kadar sık mesaj yazmayın kafam karışıyor okurken. Yoğunluktan değilde işim çıktı bir yere gitmek zorunda kaldım ondan kaynaklanıyor.

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
For ts = 4 To bordo.Cells(Rows.Count, "B").End(xlUp).Row
If bordo.Cells(ts, "A") <> " " Then
If bordo.Cells(ts, "A") = "" Then
bordo.Cells(ts, "K") = bordo.Cells(ts - 1, "K")
Else
bordo.Cells(ts, "K") = bordo.Cells(ts, "A")
End If
End If
Next
kaplan = 11
For ts = 4 To bordo.Cells(Rows.Count, "K").End(xlUp).Row
If WorksheetFunction.CountIf(bordo.Range("K4:K" & ts), _
bordo.Cells(ts, "K")) = 1 Then
mavi.Cells(kaplan, "A") = bordo.Cells(ts, "K")
kaplan = kaplan + 1
End If
Next
For trabzonspor = 11 To mavi.Cells(Rows.Count, "A").End(xlUp).Row
kaplan = 0
bordo.Range("J:J").ClearContents
For ts = 4 To bordo.Cells(Rows.Count, "K").End(xlUp).Row
If Format(bordo.Cells(ts, "K"), "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("K:K"), _
mavi.Cells(trabzonspor, "A"))
mavi.Cells(trabzonspor, "D") = WorksheetFunction.SumIf(bordo.Range("K:K"), _
mavi.Cells(trabzonspor, "A"), bordo.Range("H:H"))
Next
bordo.Range("K:K").ClearContents
Application.ScreenUpdating = True
MsgBox Format(hamsi - Time, "hh:mm:ss") & vbLf _
& "Sürede Aylık Bazda Rapor Aldım", , "Bitiş"
End Sub

Bu kod işinizi görecektir.

kucukdunyam · 19 Kasım 2011

sayın üstadım, biliyorum çok sordum, sonn bir düzeltme isteyeceğim,
formül çok güzel çalışıyor, yalnız giriş sayfasında tarih sütünunda boşluk bulunan hücrelerde mevcut, o yüzden formül sadece A sütünündeki tarihleri değil, boşluk olan satırları da getiriyor, onu sadece tarihleri getirtmesini sağlayabilirmiyiz. şimdiden teşekkür ederim. allah razı olsun,

İhsan Tank · 19 Kasım 2011

kucukdunyam' Alıntı:
sayın üstadım, biliyorum çok sordum, sonn bir düzeltme isteyeceğim,
formül çok güzel çalışıyor, yalnız giriş sayfasında tarih sütünunda boşluk bulunan hücrelerde mevcut, o yüzden formül sadece A sütünündeki tarihleri değil, boşluk olan satırları da getiriyor, onu sadece tarihleri getirtmesini sağlayabilirmiyiz. şimdiden teşekkür ederim. allah razı olsun,

Üstteki kodu güncelledim.

Korhan Ayhan · 19 Kasım 2011

Merhaba,

Örnek dosyadaki kodları daha önce ben hazırlamıştım. İstedikleriniz doğrultusunda güncelledim. Alternatif olarak aşağıdaki kodu denermisiniz.

Kod:

Sub AY_BAZINDA_RAPOR()
    Dim S1 As Worksheet, S2 As Worksheet, X As Long, Y As Long
    Dim İLK As Long, SON As Long, WF As WorksheetFunction
    Dim Satır As Long, Son_Satır As Long
    Dim Dizi_1 As New Collection, Dizi_2 As New Collection
    
    Application.ScreenUpdating = False
    Set S1 = Sheets("GİRİŞ")
    Set S2 = Sheets("İSTATİSTİK")
    Set WF = WorksheetFunction
    
    S2.Range("A11:D65536").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_1.Add CStr(S1.Cells(Y, 2)), CStr(S1.Cells(Y, 2))
                    Dizi_2.Add CStr(S1.Cells(Y, 3)), CStr(S1.Cells(Y, 3))
                Next
                
                S2.Cells(Satır - 2, 2) = Dizi_2.Count
                S2.Cells(Satır - 2, 3) = Dizi_1.Count
                S2.Cells(Satır - 2, 4) = WF.SumIf(S1.Range("B" & İLK & ":B" & SON), "<>""", S1.Range("H" & İLK & ":H" & SON))
                Set Dizi_1 = Nothing
                Set Dizi_2 = Nothing
                İLK = SON + 1
            End If
        ElseIf X = SON Then
            On Error Resume Next
            For Y = İLK To SON
                Dizi_1.Add CStr(S1.Cells(Y, 2)), CStr(S1.Cells(Y, 2))
                Dizi_2.Add CStr(S1.Cells(Y, 3)), CStr(S1.Cells(Y, 3))
            Next
            
            S2.Cells(Satır - 2, 2) = Dizi_2.Count
            S2.Cells(Satır - 2, 3) = Dizi_1.Count
            S2.Cells(Satır - 2, 4) = WF.SumIf(S1.Range("B" & İLK & ":B" & SON), "<>""", S1.Range("H" & İLK & ":H" & SON))
            Set Dizi_1 = Nothing
            Set Dizi_2 = Nothing
            İLK = SON
        End If
    Next
    
    Set S1 = Nothing
    Set S2 = Nothing
    Set WF = Nothing
    
    Application.ScreenUpdating = True
 
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

kucukdunyam · 19 Kasım 2011

Herşey için teşekkür ederim, iş tamam,

İhsan Tank · 19 Kasım 2011

kucukdunyam' Alıntı:
Herşey için teşekkür ederim, iş tamam,

Rica ederim
:keyif:

kucukdunyam · 1 Aralık 2011

Merhaba korhan bey, en son yazdığınız koda, bir işlev daha ekleyebilirmiyiz, örneğin l sütünuna da, sıfırdan büyükleri saymasını sağlayabilirmiyiz,
yani aktar sektöründe sıfırdan büyük tutanak sayısını buldurmasını istiycez,

kucukdunyam · 6 Aralık 2011

dosyayı yeniledim, içinde olan işlevlere de ihtiyacım var, zaman ayırabilirseniz çok mihnettar kalırım.

mükerrer süz ve say

İhsan Tank

Misafir

kucukdunyam

İhsan Tank

Misafir

kucukdunyam

İhsan Tank

Misafir

İhsan Tank

Misafir

kucukdunyam

kucukdunyam

kucukdunyam

kucukdunyam

İhsan Tank

Misafir

kucukdunyam

İhsan Tank

Misafir

Korhan Ayhan

Administrator

kucukdunyam

İhsan Tank

Misafir

kucukdunyam

kucukdunyam