[Yardım]  2 Tarih arasındaki verileri listbox ' a ekleme

Verilerinizi listeleyebileceğiniz liste kutusu

2 Tarih arasındaki verileri listbox ' a ekleme

İleti#1)  guter24 » 08 Kas 2021 13:14

Merhabalar okulumuzdaki öğrencilerin aidatlarını takip amaçlı ekteki gibi bir excel sayfası hazırladım. Bir konuda yardımlarınıza ihtiyacım var mesela Userform üzerindeki aidat süz düğmesi ile aidat süzme formu açıldığında formdan seçtiğim ilk ve son tarihler arasında hangi öğrenciler hangi tarihlerde aidat yatırmış ise listbox içerisine sadece o öğrencileri listelesin ve seçili tarihler arasındaki toplam tutarı göstersin. Formları araştırdım fakat çok fazla bilgim olmadığı için bir türlü başarılı olamadım.

Dosya Linki
https://dosya.co/fab1pwld1g8b/D%C3%9CZENLEME.xlsb.html
Kullanıcı avatarı
guter24
 
Kayıt: 16 Nis 2020 00:21
Meslek: müdür yard.
Yaş: 32
İleti: 2
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: balıkesir

Cevap: 2 Tarih arasındaki verileri listbox ' a ekleme

İleti#2)  hukumran » 14 Kas 2021 09:18

guter24 yazdı:Merhabalar okulumuzdaki öğrencilerin aidatlarını takip amaçlı ekteki gibi bir excel sayfası hazırladım. Bir konuda yardımlarınıza ihtiyacım var mesela Userform üzerindeki aidat süz düğmesi ile aidat süzme formu açıldığında formdan seçtiğim ilk ve son tarihler arasında hangi öğrenciler hangi tarihlerde aidat yatırmış ise listbox içerisine sadece o öğrencileri listelesin ve seçili tarihler arasındaki toplam tutarı göstersin. Formları araştırdım fakat çok fazla bilgim olmadığı için bir türlü başarılı olamadım.

Dosya Linki
https://dosya.co/fab1pwld1g8b/D%C3%9CZENLEME.xlsb.html


Merhaba hocam. Excelle uzun süredir uğraşmıyordum. Umduğumdan çok zamanımı aldığı için Para toplarken küsuratları dikkate almadan yaptım. Ve texboxda listelenen toplam para küsuratla gelmeyecektir. Eğer yapamazsanız yine bakarım pazartesi günü. İşyeri bilgisayarımda küsurat toplayan bir fonksiyonum vardı belki ondan bakıp eklerim. Şimdilik bunun için vaktim yok. Kusura bakmayın.

Kod: Tümünü seç
Dim Sht0, Sht00, Sht1, Sht2, Sht3, Sht4, Sht5, Sht6, Sht7, Sht8, Sht9 As Worksheet
Private Sub ListBtn_Click()
On Error Resume Next
    'Sayfa isimlerine değişken tanımla
        Set Sht0 = Workbooks(ThisWorkbook.Name).Worksheets("TOPLU LİSTE")
        Set Sht00 = Workbooks(ThisWorkbook.Name).Worksheets("AİDAT")
        Set Sht1 = Workbooks(ThisWorkbook.Name).Worksheets("3 YAŞ A")
        Set Sht2 = Workbooks(ThisWorkbook.Name).Worksheets("3 YAŞ B")
        Set Sht3 = Workbooks(ThisWorkbook.Name).Worksheets("3 YAŞ C")
        Set Sht4 = Workbooks(ThisWorkbook.Name).Worksheets("4 YAŞ A")
        Set Sht5 = Workbooks(ThisWorkbook.Name).Worksheets("4 YAŞ B")
        Set Sht6 = Workbooks(ThisWorkbook.Name).Worksheets("4 YAŞ C")
        Set Sht7 = Workbooks(ThisWorkbook.Name).Worksheets("5 YAŞ A")
        Set Sht8 = Workbooks(ThisWorkbook.Name).Worksheets("5 YAŞ B")
        Set Sht9 = Workbooks(ThisWorkbook.Name).Worksheets("5 YAŞ C")

Dim SinifSayfalari As Variant, PageN As Variant
        SinifSayfalari = Array(Sht1, Sht2, Sht3, Sht4, Sht5, Sht6, Sht7, Sht8, Sht9)
On Error GoTo 0
        Dim TarihF As Long, BaslaT As Long, BitisT As Long, ParaToplam As Long, Date1Tmp As String, Date2Tmp As String
        BaslaT = 20220102
        BitisT = 20220912
       
       ' MsgBox FrmList.TextBox1
        Date1Tmp = Replace(FrmList.TextBox1, "/", ".")
        Date2Tmp = Replace(FrmList.TextBox2, "/", ".")
       
        If IsDate(Date1Tmp) = False Then
             MsgBox "Geçersiz Başlangıç Tarihi"
             Exit Sub
        End If
        If IsDate(Date2Tmp) = False Then
             MsgBox "Geçersiz Bitiş Tarihi"
             Exit Sub
        End If
        If BitisT > BaslaT Then
            MsgBox "Başlangıç Tarihi Bitiş Tarihinden Büyük Olamaz"
        End If
       
      BaslaT = Replace(Format(Date1Tmp, "yyyy/mm/dd"), ".", "")
      BitisT = Replace(Format(Date2Tmp, "yyyy/mm/dd"), ".", "")

        ParaToplam = 0
        For Each PageN In SinifSayfalari
           SonHucre = PageN.Cells(Rows.Count, 1).End(xlUp).Row
            For Sutun = 7 To 24 Step 2
                 For Satir = 2 To SonHucre
                 TarihV = PageN.Cells(Satir, Sutun).Value
                 If IsDate(TarihV) = True Then
                     'PageN.Cells(Satir, Sutun).Select
                     TarihF = Replace(Format(TarihV, "yyyy/mm/dd"), ".", "")
                     If (TarihF >= BaslaT) And (TarihF <= BitisT) Then

                        OdemeMiktari = PageN.Cells(Satir, Sutun + 1).Value
                        OdemeYapanOgrenci = PageN.Cells(Satir, 3).Value
                       
                        If IsNumeric(PageN.Cells(Satir, Sutun + 1).Value) Then
                        'Para toplanıyor ama kuruşları atlar.
                            ParaToplam = ParaToplam + OdemeMiktari
                        Else
                            MsgBox PageN.Name & " Sayfası " & Sutun & " Nolu Sütun " & Satir & " Nolu Satırdaki Para Değerinde Sorun var"
                        End If
                       
                        FrmList.ListBox1.AddItem OdemeYapanOgrenci
                        'Debug.Print PageN.Cells(Satir, Sutun).Value & "  " & PageN.Cells(Satir, Sutun + 1).Value
                     End If
                End If
                 Next Satir
            Next Sutun
        Next PageN
    FrmList.TextBox3 = ParaToplam
End Sub
Kullanıcı avatarı
hukumran
Siteye Alışmış
 
Adı Soyadı:Hasan Salihoğlu
Kayıt: 15 Tem 2014 14:44
Konum: İstanbul
Meslek: Grafiker
Yaş: 34
İleti: 145
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul

Cevap: 2 Tarih arasındaki verileri listbox ' a ekleme

İleti#3)  hukumran » 14 Kas 2021 09:34

Ayrıca Tarih ekleme butonlarını da şöyle yapın: Yoksa düzgün çalışmayacaktır.

Kod: Tümünü seç
Private Sub Image1_Click()

Dim myDate As Date

    myDate = CalendarForm.GetDate(FirstDayOfWeek:=Monday, SaturdayFontColor:=RGB(250, 0, 0), SundayFontColor:=RGB(250, 0, 0))
    myDate = Format(myDate, "dd/mm/yyyy")
    If myDate > 0 Then TextBox1.Value = myDate

End Sub

Private Sub Image2_Click()

Dim myDate As Date

    myDate = CalendarForm.GetDate(FirstDayOfWeek:=Monday, SaturdayFontColor:=RGB(250, 0, 0), SundayFontColor:=RGB(250, 0, 0))
    myDate = Format(myDate, "dd/mm/yyyy")
    If myDate > 0 Then TextBox2.Value = myDate

End Sub
Kullanıcı avatarı
hukumran
Siteye Alışmış
 
Adı Soyadı:Hasan Salihoğlu
Kayıt: 15 Tem 2014 14:44
Konum: İstanbul
Meslek: Grafiker
Yaş: 34
İleti: 145
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul

Cevap: 2 Tarih arasındaki verileri listbox ' a ekleme

İleti#4)  guter24 » 18 Kas 2021 14:24

Sayın "Hukumran" öncelikle ilgilenip geri dönüş yaptığınız için çok teşekkür ediyorum. Seçilen tarihler arasında hangi öğrenciler aidat yatırmış ise o öğrencileri seçip listeleme özelliği ve toplam yatırılan tutarı gösterme özelliği gayet başarılı. Eğer mümkün ise küçük bir ekleme daha yapabilir miyiz ? Şöyle ki; seçilen tarih aralığına göre listbox içerisinde öğrenci isimleri listelendiğinde hangi tarihte ne kadar aidat yatırdıkları da listelensin. Belki tam olarak anlatamamış olabilirim o yüzden link e dosyanın güncel halini ve yukarıda anlatmak istediğim olayın ekran resmini koyuyorum vakit ayırdığınız için tekrardan teşekkürlerimi sunuyorum.

https://dosya.co/ji5seaoqw45q/Screenshot_3.jpg.html

https://dosya.co/wq759iscs98g/ÖRNEK_DOSYA.xlsb.html
Kullanıcı avatarı
guter24
 
Kayıt: 16 Nis 2020 00:21
Meslek: müdür yard.
Yaş: 32
İleti: 2
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: balıkesir

REKLAM
Excel Logo XML Oluşturucu
Logo Object Designer ile Uyarlama

Cevap: 2 Tarih arasındaki verileri listbox ' a ekleme

İleti#5)  hukumran » 20 Kas 2021 06:33

İstediğin gibi olmuştur umarım. Benim anladığım böyle oldu. Karmaşık kodlama için kusura bakmayın. Vba ile daha basit şekilde yapmak istedim ama obje türü veri saklama yöntemlerinin kullanımı da karmaşıktı. Her seferinde Listbox üzerinde kontrol yapılıp ona göre eklemeler yapılıyor, en azından kullandığımız araçlar üzerinden yapılmış oldu. Çok fazla döngü ve if var. Değiştirilmesi ve bakımı zor kodlar oluşuyor, iki gün sonra bu koda birşey eklemek istemem doğrusu. :) Ama bu karmaşıklık sanırım Microsoftun suçu. :)

Kod: Tümünü seç
Dim Sht0, Sht00, Sht1, Sht2, Sht3, Sht4, Sht5, Sht6, Sht7, Sht8, Sht9 As Worksheet

Private Sub ListBtn_Click()

On Error Resume Next
    'Sayfa isimlerine değişken tanımla
        Set Sht0 = Workbooks(ThisWorkbook.name).Worksheets("TOPLU LİSTE")
        Set Sht00 = Workbooks(ThisWorkbook.name).Worksheets("AİDAT")
        Set Sht1 = Workbooks(ThisWorkbook.name).Worksheets("3 YAŞ A")
        Set Sht2 = Workbooks(ThisWorkbook.name).Worksheets("3 YAŞ B")
        Set Sht3 = Workbooks(ThisWorkbook.name).Worksheets("3 YAŞ C")
        Set Sht4 = Workbooks(ThisWorkbook.name).Worksheets("4 YAŞ A")
        Set Sht5 = Workbooks(ThisWorkbook.name).Worksheets("4 YAŞ B")
        Set Sht6 = Workbooks(ThisWorkbook.name).Worksheets("4 YAŞ C")
        Set Sht7 = Workbooks(ThisWorkbook.name).Worksheets("5 YAŞ A")
        Set Sht8 = Workbooks(ThisWorkbook.name).Worksheets("5 YAŞ B")
        Set Sht9 = Workbooks(ThisWorkbook.name).Worksheets("5 YAŞ C")

ListBox1.Clear
ListBox1.ColumnHeads = False
ListBox1.ColumnCount = 7

Dim SinifSayfalari As Variant, PageN As Variant
        SinifSayfalari = Array(Sht1, Sht2, Sht3, Sht4, Sht5, Sht6, Sht7, Sht8, Sht9) ' yeni sınıf eklenirse buraya da eklenmek zorunda.

On Error GoTo 0
       
        Dim TarihF As Long, BaslaT As Long, BitisT As Long, ParaToplam As Long, Date1Tmp As String, Date2Tmp As String

       
       ' MsgBox FrmList.TextBox1
        Date1Tmp = Replace(FrmList.TextBox1, "/", ".")
        Date2Tmp = Replace(FrmList.TextBox2, "/", ".")
       
        If IsDate(Date1Tmp) = False Then
             MsgBox "Geçersiz Başlangıç Tarihi"
             Exit Sub
        End If
        If IsDate(Date2Tmp) = False Then
             MsgBox "Geçersiz Bitiş Tarihi"
             Exit Sub
        End If
        If BitisT < BaslaT Then
            MsgBox "Başlangıç Tarihi Bitiş Tarihinden Büyük Olamaz"
        End If
       
      BaslaT = Replace(Format(Date1Tmp, "yyyy/mm/dd"), ".", "")
      BitisT = Replace(Format(Date2Tmp, "yyyy/mm/dd"), ".", "")
        FrmList.ListBox1.ColumnWidths = 130
        FrmList.ListBox1.ColumnCount = 10 ' 9 ay var 0 dan başladığı için 10 sütun olacak
        ParaToplam = 0
       
       
        Dim SutunIslemiTamam As Boolean
        Dim BilgileriBirlestir As String
        Dim SinifAdi As String
        Dim OdemeYapanOgrenci As String
        Dim OdemeMiktari As Long
        Dim OgrenciNo As Integer
       
        For Each PageN In SinifSayfalari ' tüm sınıf adlarının içinde dönüyoruz.
           SonHucre = PageN.Cells(Rows.Count, 1).End(xlUp).Row
            For Sutun = 7 To 24 Step 2 ' Tarih ve aidat bilgisi 7. sütundan başlıyor. ikişek ikişer atlıyoruz tarih + ödeme miktarı iki sutun çünkü
                 For Satir = 2 To SonHucre ' başlık bilgisini atlayıp 2 den başlıyoruz ve son dolu hücreye kadar gidiyoruz.
                 TarihV = PageN.Cells(Satir, Sutun).Value
                 If IsDate(TarihV) = True Then ' doğru bir tarih olup olmadığını kontyrol ediyoruz. tarih geçersizse tüm satırlar atlanacak. Dilerseniz else ile tarih yanlışsa bir mesaj gösterebilirsiniz.
                     'PageN.Cells(Satir, Sutun).Select
                     TarihF = Replace(Format(TarihV, "yyyy/mm/dd"), ".", "") ' taraihi 20010101 formatına dönüştürüyoruz "gün ay yıl" bu sayede hangi tarihin diğerinden daha büyük olduğunu çok basit şekilde anlıyoruz. rakamsal değeri büyük olan büyük tarihtir bu formatta
                     If (TarihF >= BaslaT) And (TarihF <= BitisT) Then

                        OdemeMiktari = PageN.Cells(Satir, Sutun + 1).Value
                        OgrenciNo = PageN.Cells(Satir, 1).Value ' aynı isimden birden fazla öğrenci olabilir diye öğrenci nosunu da alıyoruz.
                        OdemeYapanOgrenci = PageN.Cells(Satir, 3).Value
                        SinifAdi = PageN.name ' Farklı sınıflarda aynı sıra numarası ve aynı adlı öğrenci olabilir diye sınıf adını da alıyoruz
                        BilgileriBirlestir = SinifAdi & "-" & OgrenciNo & "-" & OdemeYapanOgrenci
                       
                        If IsNumeric(PageN.Cells(Satir, Sutun + 1).Value) Then ' para hücresinde ödeme yapmadı kayır sildi gibi şeyler yazıyorsa numeric olmuyor ve atlıyoruz.
                        'Para toplanıyor ama kuruşları atlar.
                            ParaToplam = ParaToplam + OdemeMiktari
                        Else
                            MsgBox PageN.name & " Sayfası " & Sutun & " Nolu Sütun " & Satir & " Nolu Satırdaki Para Değerinde Sorun var"
                        End If
                       
                        SutunIslemiTamam = False ' Varsayılan olarak falsedir ama her döngüde trueya döneceği için burada düzeltiyoruz.
                       
                        For i = 0 To ListBox1.ListCount - 1 ' eklenen tüm öğrencileri bu döngü ile dolaşıyoruz
                            If FrmList.ListBox1.List(i, 0) = BilgileriBirlestir Then 'bu if ile öğrencinin eklenip eklenmediğini kontrol ediyoruz
                            For j = 2 To 10 ' bu for ile öğrecinin sütunlarında son para ödediği tarihi buluyoruz. isim 0 . sütunda olduğu için ve ilk tarih ilk eklemede eklendiği için 2 ile başlıyoruz
                                If IsNull(FrmList.ListBox1.List(i, j)) Then ' sonunda boş sütuna denk gelince bu koşulun içine giriliyor ve bilgiler ekleniyor
                                    FrmList.ListBox1.Column(j, i) = TarihV & "-" & OdemeMiktari & ChrW(8378) ' ödeme mikatarını ve tarihi öğrenciye ekliyrouz en son da tl işaretini unicode olarak ekliyoruz
                                    SutunIslemiTamam = True ' tüm satırları dolaşan üst döngüden de artık çıkmalıyız bu değişken ile üst döngüye haber ulaştıracğaız.
                                    Exit For
                                End If
                            Next j
                            Else ' Eğer bu isim daha önce girilmemişse şimdi girip ilk tarih ve ödemeyi ekliyoruz.
                            End If
                            If SutunIslemiTamam = True Then Exit For ' Tarih ve ödeme girildi artık bu döngüden de çıkış yapmalıyız.
                        Next i
                       
                            If SutunIslemiTamam = True Then Exit For ' Tarih ve ödeme girildi artık bu demektir ki şu anda yeni kayıt yapmıyoruz o yüzden çıkış yapıyoruz
                           
                            FrmList.ListBox1.AddItem BilgileriBirlestir ' bu öğrenci listede daha önceden eklenmemişse burada ekleniyor. Aksi takdirede üst satırdaki if ile çıkacak buraya gelmeyecek
                            FrmList.ListBox1.Column(1, i) = TarihV & "-" & OdemeMiktari & ChrW(8378) ' yeni öğrenci üst satırda eklendi şimdi ilk ödeme taihi ve ödeme miktarını giriyoruz. unicode tl simgesini ekliyoruz
                     End If
                End If
                 Next Satir
            Next Sutun
        Next PageN
FrmList.TextBox3 = ParaToplam & " TL"
End Sub
Kullanıcı avatarı
hukumran
Siteye Alışmış
 
Adı Soyadı:Hasan Salihoğlu
Kayıt: 15 Tem 2014 14:44
Konum: İstanbul
Meslek: Grafiker
Yaş: 34
İleti: 145
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul

Cevap: 2 Tarih arasındaki verileri listbox ' a ekleme

İleti#6)  hukumran » 20 Kas 2021 06:38

Bu arada son satırı böyle yapın dilerseniz:

Kod: Tümünü seç
FrmList.TextBox3 = ParaToplam & " " & ChrW(8378)  ' ChrW(8378)  Tl simgesini yazar. Vba Ansi olduğu için Tlyi unicode yazma fonksiyonu kullanarak tl nin unicode sırası olan 8378 ile yazdırabiliyoruz.
Kullanıcı avatarı
hukumran
Siteye Alışmış
 
Adı Soyadı:Hasan Salihoğlu
Kayıt: 15 Tem 2014 14:44
Konum: İstanbul
Meslek: Grafiker
Yaş: 34
İleti: 145
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul

REKLAM
ETA - Excel Konsolide Raporlama
ETA Excel Personel Entegre Raporu

Forum ListBox

Online Kullanıcılar

Bu forumu görüntüleyenler: Kayıtlı kullanıcı yok ve 0 misafir

Bumerang - Yazarkafe