İki Tarih Arası Veri Listeleme

[Ziynettin]

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.

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]

Merhaba,

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

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]

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]

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?

        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

 

[Ziynettin]

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.

 

[Ömer BARAN]

Anladım Sayın @Ziynettin, açıklama için teşekkürler.

 

[denese]

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.

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

 

[denese]

Değerli desteklerinize ihtiyacım var. Tekrar yardımcı olabilirseniz çok sevinirim.

 

[Ziynettin]

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.

 

[denese]

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.

 

[Ziynettin]

#48. iletide kırmızı yazılı satırı yendin yazıp deneyin.

 

[denese]

Çok teşekkür ederim Sayın @Ziynettin, elinize sağlık..