İki Tarih Arası Veri Listeleme

Ziynettin

Destek Ekibi
Destek Ekibi
Katılım
18 Nisan 2008
Mesajlar
1,104
Excel Vers. ve Dili
office2010
Merhaba değerli hocalarım,

2 nolu mesajdaki Sayın @Ömer BARAN' ın "Kriterli_listeleme" makrosunu, benzer bir çalışmaya uyarlamaya çalıştım. Fakat işin içinden çıkamadım. Detayları ekli dosya üzerinde belittim. Tekrar yardımlarınızı rica ediyorum.

Yukarıda, benzer bir çalışmadaki sayın @Ziynettin' e ait kod gerçekten çok hızlı. Ekteki çalışmayı da aynı yöntemle yapabilir miyiz?

İyi günler dilerim.
Merhaba,

Ömer Bey, çözüm sunmuş. Bu da alternatif olsun.

Kod:
Sub Listele()
Dim s1 As Worksheet, s2 As Worksheet, a(), b()
Dim t1 As Date, t2 As Date, sicil As String
    Set s1 = Sheets("Data")
    Set s2 = Sheets("Mutabakat")
    t1 = s2.[F5]: t2 = s2.[F6]: sicil = [i3]
    a = s1.Range("A2:J" & s1.Cells(Rows.Count, 1).End(3).Row).Value
    ReDim b(1 To UBound(a), 1 To 6)
        For i = 1 To UBound(a)
            If CStr(a(i, 1)) = sicil Then
                If a(i, 7) >= t1 And a(i, 8) <= t2 Then
                    say = say + 1
                    b(say, 1) = a(i, 4)
                    b(say, 2) = a(i, 5)
                    b(say, 3) = a(i, 7)
                    b(say, 4) = a(i, 8)
                    b(say, 5) = a(i, 9)
                    b(say, 6) = a(i, 10)
                End If
            End If
        Next i
    s2.Range("A21:F" & Rows.Count).ClearContents
    If say > 0 Then
        s2.[B21].Resize(say).NumberFormat = "@"
        s2.[C21].Resize(say, 3).NumberFormat = "dd.mm.yyyy"
        s2.[F21].Resize(say).NumberFormat = "#,##0.00"
        s2.[A21].Resize(say, 6) = b
    End If
MsgBox "İşlem bitti.", vbInformation
End Sub
 

denese

Altın Üye
Katılım
17 Mart 2011
Mesajlar
432
Excel Vers. ve Dili
Office 2019
Merhaba,

Ömer Bey, çözüm sunmuş. Bu da alternatif olsun.

Kod:
Sub Listele()
Dim s1 As Worksheet, s2 As Worksheet, a(), b()
Dim t1 As Date, t2 As Date, sicil As String
    Set s1 = Sheets("Data")
    Set s2 = Sheets("Mutabakat")
    t1 = s2.[F5]: t2 = s2.[F6]: sicil = [i3]
    a = s1.Range("A2:J" & s1.Cells(Rows.Count, 1).End(3).Row).Value
    ReDim b(1 To UBound(a), 1 To 6)
        For i = 1 To UBound(a)
            If CStr(a(i, 1)) = sicil Then
                If a(i, 7) >= t1 And a(i, 8) <= t2 Then
                    say = say + 1
                    b(say, 1) = a(i, 4)
                    b(say, 2) = a(i, 5)
                    b(say, 3) = a(i, 7)
                    b(say, 4) = a(i, 8)
                    b(say, 5) = a(i, 9)
                    b(say, 6) = a(i, 10)
                End If
            End If
        Next i
    s2.Range("A21:F" & Rows.Count).ClearContents
    If say > 0 Then
        s2.[B21].Resize(say).NumberFormat = "@"
        s2.[C21].Resize(say, 3).NumberFormat = "dd.mm.yyyy"
        s2.[F21].Resize(say).NumberFormat = "#,##0.00"
        s2.[A21].Resize(say, 6) = b
    End If
MsgBox "İşlem bitti.", vbInformation
End Sub
Sayın @Ziynettin çok teşekkürler, harikasınız.
 

Ziynettin

Destek Ekibi
Destek Ekibi
Katılım
18 Nisan 2008
Mesajlar
1,104
Excel Vers. ve Dili
office2010
t1 = s2.[F5]: t2 = s2.[F6]: sicil = s2.[i3]

Kod satırında kırmızı yazı eksik olmuş kodda düzenleme yapınız.
 

Ömer BARAN

Uzman
Katılım
8 Mart 2011
Mesajlar
13,002
Excel Vers. ve Dili
Office 2013 ( 32 bit ) TÜRKÇE
Merhaba Sayın @Ziynettin , son kod cevabınızla ilgili iki şey sormak istiyorum.

-- Kod'da neden kırmızı satırları silip mavileri ekleyerek işlem yapılmadığını açıklamanız mümkün müdür?
-- Bir de sicil bilgisi, neden doğrudan a(i, 1)=sicil yerine Cstr(a(i, 1)) = sicil şeklinde karşılaştırılıyor, veri türleri aynı değil mi?
Rich (BB code):
        For i = 1 To UBound(a)
            If CStr(a(i, 1)) = sicil Then
                If CStr(a(i, 1)) = sicil And a(i, 7) >= t1 And a(i, 8) <= t2 Then
                    say = say + 1
                    .....................
                End If
            End If
        Next i
 
Son düzenleme:

Ziynettin

Destek Ekibi
Destek Ekibi
Katılım
18 Nisan 2008
Mesajlar
1,104
Excel Vers. ve Dili
office2010
Merhaba Ömer Bey,

If CStr(a(i, 1)) = sicil Then kod satırını If CStr(a(i, 1)) = sicil And a(i, 7) >= t1 And a(i, 8) <= t2 Then tek satır olarak kullanılır, aynı sonuç alınır.
Bu kodu yazana bağlı bir durum.

CStr ise;
Sicil verileri işlenirken sayı ya da metin olabilir.

Örnek üzerinden gidelim,
1. Data sayfası [A12631] hücresindeki değeri ('22905) metin olarak biçimlendirin.
2. Dim t1 As Date, t2 As Date, sicil As String satırında koyu koyu yazıyı silin.
3. If CStr(a(i, 1)) = sicil Then satırında koyu koyu yazıyı silin ve sonucu gözlemleyiniz.
 

denese

Altın Üye
Katılım
17 Mart 2011
Mesajlar
432
Excel Vers. ve Dili
Office 2019
Tekrar Merhaba,

Sayın @Ziynettin Bey' in aşağıdaki koduyla iki tarih aralığına göre izinleri listeliyorum. Yapmak istediğim "J" sütunundaki izin gün sayısına göre sadece 10 gün ve üzeri olan izinleri listeleyebilmek. Dosya ekte yer alıyor.

Yardımcı olabilir misiniz.


Kod:
Sub Tarihe_Gore_Listele()
Dim s1 As Worksheet, s2 As Worksheet, a(), b()
Dim t1 As Date, t2 As Date, sicil As String
    Set s1 = Sheets("Data")
    Set s2 = Sheets("Listele")
    t1 = s2.[B2]: t2 = s2.[C2]: sicil = s2.[A2]
    a = s1.Range("A2:J" & s1.Cells(Rows.Count, 1).End(3).Row).Value
    ReDim b(1 To UBound(a), 1 To 10)
        For i = 1 To UBound(a)
            If CStr(a(i, 1)) = sicil Then
                If a(i, 7) >= t1 And a(i, 8) <= t2 Then
                    say = say + 1
                    b(say, 1) = a(i, 1)
                    b(say, 2) = a(i, 2)
                    b(say, 3) = a(i, 3)
                    b(say, 4) = a(i, 4)
                    b(say, 5) = a(i, 5)
                    b(say, 6) = a(i, 6)
                    b(say, 7) = a(i, 7)
                    b(say, 8) = a(i, 8)
                    b(say, 9) = a(i, 9)
                    b(say, 10) = a(i, 10)
                End If
            End If
        Next i
    s2.Range("A5:J" & Rows.Count).ClearContents
    If say > 0 Then
        s2.[E5].Resize(say).NumberFormat = "@"
        s2.[G5].Resize(say, 3).NumberFormat = "dd.mm.yyyy"
        s2.[J5].Resize(say).NumberFormat = "#,##0.00"
        s2.[A5].Resize(say, 10) = b
    End If
MsgBox "İşlem bitti.", vbInformation
End Sub
 

Ekli dosyalar

denese

Altın Üye
Katılım
17 Mart 2011
Mesajlar
432
Excel Vers. ve Dili
Office 2019
Değerli desteklerinize ihtiyacım var. Tekrar yardımcı olabilirseniz çok sevinirim.
 

Ziynettin

Destek Ekibi
Destek Ekibi
Katılım
18 Nisan 2008
Mesajlar
1,104
Excel Vers. ve Dili
office2010
Merhaba,

If a(i, 7) >= t1 And a(i, 8) <= t2 Then

satırını yerine ;

If a(i, 7) >= t1 And a(i, 8) <= t2 and a(i,10)>=10 Then

şeklinde deneyin.
 
Son düzenleme:

denese

Altın Üye
Katılım
17 Mart 2011
Mesajlar
432
Excel Vers. ve Dili
Office 2019
Merhaba Sayın @Ziynettin, belirttiğiniz değişikliği uygulayarak denedim. Fakat yine tüm izinler listeleniyor. Yapmak istediğim, tek seferde 10 gün ve üzeri kullanılan izinleri listelemek. Örneğin, 15970 sicil numarası aşağıdaki tarih aralığında listeleme yaptığımda sonuç aşağıdaki gibi olmalı. Desteğiniz için çok teşekkür ederim.

Adsız.jpg
 

Ekli dosyalar

Ziynettin

Destek Ekibi
Destek Ekibi
Katılım
18 Nisan 2008
Mesajlar
1,104
Excel Vers. ve Dili
office2010
#48. iletide kırmızı yazılı satırı yendin yazıp deneyin.
 

denese

Altın Üye
Katılım
17 Mart 2011
Mesajlar
432
Excel Vers. ve Dili
Office 2019
Çok teşekkür ederim Sayın @Ziynettin, elinize sağlık..
 
Üst