Listview İki Tarih Arası Benzersiz Değer Filtreleme

walabi · 13 Haziran 2023

Merhaba,

Aşağıdaki kod ile şunu yapmaya çalışıyorum. S1 veri sayfasından N sütunundaki Malzeme kodlarını benzersiz değer olarak Listview e almaya çalışıyorum. Benzersiz fonksiyonu ile beraber sadece kod verilerini kullandığım zaman istediğim gibi sonuç alıyorum. Ancak işin içine iki tarih arası veri listelemeyi katmaya çalıştığımda ulaştığım sonuçlar yanlış olmakta. CLng ve cDate nin varyasyonlarını denedim ama istediğim sonuca ulaşamadım. Problem neyle ilgili olabilir?

S1 deki N sütunu malzeme kodu
S1 deki F sütunu Tarih bilgisi

Kod:

Private Sub CommandButton5_Click()
ListView1.ListItems.Clear

If CheckBox1 = False Then Exit Sub

Set s1 = Sheets("Detaylı_Alış_Faturaları")
Set s2 = Sheets("STOK_SA")
Dim VeriTarihi As Date

Son = Sheets("Detaylı_Alış_Faturaları").[A65536].End(3).Row
sonsatir = s1.Range("A88888").End(xlUp).Row






    For y = 2 To s1.[A65536].End(xlUp).Row
    VeriTarihi = s1.Range("F" & y).Value
        If CLng(CDate(VeriTarihi)) >= CLng(CDate(TextBox2)) And CLng(CDate(VeriTarihi)) <= CLng(CDate(TextBox3)) Then
        'If Left(s1.Cells(y, "N"), 1) >= ComboBox1.Value And Left(s1.Cells(y, "N"), 1) <= ComboBox2.Value Then
        If WorksheetFunction.CountIf(s1.Range("N2:N" & y), s1.Cells(y, "N").Value) = 1 Then
        

            Set liste = ListView1.ListItems.Add(, , s1.Cells(y, "N").Value)
            liste.SubItems(1) = s1.Cells(y, "N").Value
            liste.SubItems(2) = s1.Cells(y, "O").Value
    
            
        End If
        'End If
        End If
    Next y
End Sub

walabi · 13 Haziran 2023

Merhaba,

Açmış olduğum konu ile ilgili bir örnek dosya ekledim. Userform üzerinde 2 adet buton altında normal ve benzersiz değerleri listelemekle ilgili kodlar oluşturdum. Normal hali ile verileri doğru listeleyebiliyorum. Ancak iki tarih arasında benzersiz değerleri listelemek istediğimde kullandığım kodlar gereken doğru sonucu vermiyor. Bunun sebebi ne olabilir??

Kod:

ListView1.ListItems.Clear

Set s1 = Sheets("veri")

Dim VeriTarihi As Date
Dim BasTarih As Date
Dim SonTarih As Date

BasTarih = TextBox2.Value
SonTarih = TextBox3.Value



    For y = 2 To s1.[A65536].End(xlUp).Row
    VeriTarihi = s1.Range("C" & y).Value
 
        'If FormatNumber(VeriTarihi * 1, 0) >= FormatNumber(BasTarih * 1, 0) And FormatNumber(VeriTarihi * 1, 0) <= FormatNumber(SonTarih * 1, 0) And Left(s1.Cells(y, "E"), 1) >= ComboBox1.Value And Left(s1.Cells(y, "E"), 1) <= ComboBox2.Value And WorksheetFunction.CountIf(s1.Range("E2:E" & y), s1.Cells(y, "E").Value) = 1 Then
        If FormatNumber(VeriTarihi * 1, 0) >= FormatNumber(BasTarih * 1, 0) And FormatNumber(VeriTarihi * 1, 0) <= FormatNumber(SonTarih * 1, 0) And WorksheetFunction.CountIf(s1.Range("E2:E" & y), s1.Cells(y, "E").Value) = 1 Then
            ' and WorksheetFunction.CountIf(s1.Range("E2:E" & y), s1.Cells(y, "E").Value) = 1
            Set liste = ListView1.ListItems.Add(, , s1.Cells(y, "E").Value)
            liste.SubItems(1) = s1.Cells(y, "E").Value
            liste.SubItems(2) = s1.Cells(y, "F").Value
            

        End If
    Next y

Bu kodda tarih kriterleri ile beraber WorksheetFunction.CountIf(s1.Range("E2:E" & y), s1.Cells(y, "E").Value) = 1 ifadesi uygun sonucu vermiyor.

Korhan Ayhan · 14 Haziran 2023

Siz sorgu kısmında EĞERSAY kullanmışsınız. Bunun yerine ÇOKEĞERSAY kullanmalısınız.

If WorksheetFunction.CountIfs(s1.Range("E:E"), s1.Cells(y, "E").Value, VeriTarihi, ">=" & BasTarih, VeriTarihi, "<=" & SonTarih) = 1 Then

walabi · 14 Haziran 2023

Korhan Ayhan' Alıntı:
Siz sorgu kısmında EĞERSAY kullanmışsınız. Bunun yerine ÇOKEĞERSAY kullanmalısınız.

If WorksheetFunction.CountIfs(s1.Range("E:E"), s1.Cells(y, "E").Value, VeriTarihi, ">=" & BasTarih, VeriTarihi, "<=" & SonTarih) = 1 Then

Korhan bey, sizin yazdığınız kod satırını olduğu gibi eklediğimde hata alıyorum. VeriTarihi kısmını kaldırıp yerine s1.Range("C:C") ifadesini yazdığımda hata almadan kod işliyor ancak istediğim sonuca yine ulaşamıyorum. Açıkcası anlamadım.

Kod:

Private Sub CommandButton3_Click()
    
ListView1.ListItems.Clear

If TextBox2 = Empty Or TextBox3 = Empty Then Exit Sub


Set s1 = Sheets("veri")


Dim BasTarih As Date
Dim SonTarih As Date

BasTarih = TextBox2
SonTarih = TextBox3


    For y = 2 To s1.[A65536].End(xlUp).Row
        If WorksheetFunction.CountIfs(s1.Range("E:E"), s1.Cells(y, "E").Value, s1.Range("C:C"), ">=" & CLng(BasTarih), s1.Range("C:C"), "<=" & CLng(SonTarih)) = 1 Then
          
            Set liste = ListView1.ListItems.Add(, , s1.Cells(y, "E").Value)
            liste.SubItems(1) = s1.Cells(y, "E").Value
            liste.SubItems(2) = s1.Cells(y, "F").Value
            

        End If
    Next y
    
    
    TextBox1 = ListView1.ListItems.Count & " Adet Listelenen"
    
    MsgBox CLng(BasTarih) & " - " & CLng(SonTarih)
  
End Sub

Korhan Ayhan · 15 Haziran 2023

Dosyanızı işyerinde çalıştıramadığım için deneme fırsatım olmadı. Bu sebeple koşul ya da yazım hatası olabilir. Cevap gelmezse akşam evden bakarım.

walabi · 15 Haziran 2023

Korhan Ayhan' Alıntı:
Dosyanızı işyerinde çalıştıramadığım için deneme fırsatım olmadı. Bu sebeple koşul ya da yazım hatası olabilir. Cevap gelmezse akşam evden bakarım.

Korhan bey merhaba,

Biraz inceledim, ancak çokeğersay ile nasıl listelenebilir bulamadım. Aklıma şu geldi. İşlem sırasına göre önce listview verileri alıp , sonra listview üzerindeki tekrar eden ( mükerrer ) verileri yani satırları silip Benzersiz değerlere dönüştürebilir miyiz. Listele ve Mükerrerleri (Tekrarlanan) Sil şeklinde bir kod bloğu ile aynı sonuca varırım diye düşündüm. Listview üzerinde tekrardan eden kayıtları silecek bir kod nasıl olabilir?

Korhan Ayhan · 15 Haziran 2023

Gereksiz yere iş uzamış olur..

Korhan Ayhan · 16 Haziran 2023

İşyerinde ListView1 hata verdiği için bende formunuza bir adet ListBox ekleyerek aşağıdaki kodu uyguladım. Sanırım doğru sonuçları elde ettim. Siz biraz kurcalayarak ListView1 nesnesine uyarlarsınız.

C++:

Private Sub CommandButton3_Click()
    Dim WF As WorksheetFunction, No As Long
    Dim First_Date As Date, Last_Date As Date
    Dim S1 As Worksheet, My_Data As Variant
    Dim Stock_Code As Object, X As Long
   
    Set S1 = Sheets("veri")
    Set WF = WorksheetFunction
    Set Stock_Code = VBA.CreateObject("Scripting.Dictionary")
   
    ListBox1.Clear
    ListBox1.ColumnCount = 2
   
    First_Date = TextBox2
    Last_Date = TextBox3
   
    My_Data = S1.Range("A1").CurrentRegion.Value
   
    ReDim My_List(1 To 2, 1 To UBound(My_Data, 1))
   
    For X = LBound(My_Data, 1) To UBound(My_Data, 1)
        If My_Data(X, 3) >= First_Date And My_Data(X, 3) <= Last_Date Then
            If Not Stock_Code.Exists(My_Data(X, 5)) Then
                No = No + 1
                Stock_Code.Add My_Data(X, 5), No
                ReDim Preserve My_List(1 To 2, 1 To No)
                My_List(1, No) = My_Data(X, 5)
                My_List(2, No) = My_Data(X, 6)
            End If
        End If
    Next
   
    ListBox1.Column = My_List

    Set S1 = Nothing
    Set WF = Nothing
    Set Stock_Code = Nothing
End Sub

Korhan Ayhan · 16 Haziran 2023

Bu da ADO ile çözüm..

C++:

Private Sub CommandButton3_Click()
    Dim My_Connection As Object, My_Query As String
    Dim First_Date As Date, Last_Date As Date
    
    Set My_Connection = CreateObject("AdoDB.Connection")
    First_Date = TextBox2
    Last_Date = TextBox3
    
    My_Connection.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
    ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;Hdr=No"""
    
    My_Query = "Select Distinct F5,F6 From [veri$A2:G] Where F3 Between " & _
                CLng(First_Date) & " And " & CLng(Last_Date) & ""
    
    ListBox1.Clear
    ListBox1.ColumnCount = 2
    ListBox1.Column = My_Connection.Execute(My_Query).GetRows

    My_Connection.Close

    Set My_Connection = Nothing
End Sub

walabi · 16 Haziran 2023

Korhan Ayhan' Alıntı:

İşyerinde ListView1 hata verdiği için bende formunuza bir adet ListBox ekleyerek aşağıdaki kodu uyguladım. Sanırım doğru sonuçları elde ettim. Siz biraz kurcalayarak ListView1 nesnesine uyarlarsınız.

C++:

Private Sub CommandButton3_Click()
    Dim WF As WorksheetFunction, No As Long
    Dim First_Date As Date, Last_Date As Date
    Dim S1 As Worksheet, My_Data As Variant
    Dim Stock_Code As Object, X As Long
  
    Set S1 = Sheets("veri")
    Set WF = WorksheetFunction
    Set Stock_Code = VBA.CreateObject("Scripting.Dictionary")
  
    ListBox1.Clear
    ListBox1.ColumnCount = 2
  
    First_Date = TextBox2
    Last_Date = TextBox3
  
    My_Data = S1.Range("A1").CurrentRegion.Value
  
    ReDim My_List(1 To 2, 1 To UBound(My_Data, 1))
  
    For X = LBound(My_Data, 1) To UBound(My_Data, 1)
        If My_Data(X, 3) >= First_Date And My_Data(X, 3) <= Last_Date Then
            If Not Stock_Code.Exists(My_Data(X, 5)) Then
                No = No + 1
                Stock_Code.Add My_Data(X, 5), No
                ReDim Preserve My_List(1 To 2, 1 To No)
                My_List(1, No) = My_Data(X, 5)
                My_List(2, No) = My_Data(X, 6)
            End If
        End If
    Next
  
    ListBox1.Column = My_List

    Set S1 = Nothing
    Set WF = Nothing
    Set Stock_Code = Nothing
End Sub

Korhan bey rica etsem listviewe bu kodların uyarlanmış halini yazabilir misiniz. Listbox ve Listview farklı olduğu için açıkcası listview e nasıl uyarlanabilir çözemedim.

Korhan Ayhan · 17 Haziran 2023

Deneyiniz.

C++:

Private Sub CommandButton3_Click()
    Dim My_Connection As Object, My_Recordset As Object, Liste As Object
    Dim My_Query As String, First_Date As Date, Last_Date As Date
    
    If TextBox2 = "" Or TextBox3 = "" Then Exit Sub
    
    Set My_Connection = CreateObject("AdoDB.Connection")
    First_Date = TextBox2
    Last_Date = TextBox3
    
    My_Connection.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
    ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;Hdr=No"""
    
    My_Query = "Select Distinct F5,F6 From [veri$A2:G] Where F3 Between " & _
                CLng(First_Date) & " And " & CLng(Last_Date) & ""
    
    Set My_Recordset = My_Connection.Execute(My_Query)
    
    On Error Resume Next
    
    With ListView1
        .ListItems.Clear
        Do While Not My_Recordset.EOF
            Set Liste = ListView1.ListItems.Add(, , My_Recordset.Fields(0).Value)
            Liste.SubItems(1) = My_Recordset.Fields(0).Value
            Liste.SubItems(2) = My_Recordset.Fields(1).Value
            My_Recordset.MoveNext
        Loop
    End With
    
    On Error GoTo 0
    
    My_Recordset.Close
    My_Connection.Close

    Set Liste = Nothing
    Set My_Recordset = Nothing
    Set My_Connection = Nothing
End Sub

walabi · 17 Haziran 2023

Korhan Ayhan' Alıntı:

Deneyiniz.

C++:

Private Sub CommandButton3_Click()
    Dim My_Connection As Object, My_Recordset As Object, Liste As Object
    Dim My_Query As String, First_Date As Date, Last_Date As Date
   
    If TextBox2 = "" Or TextBox3 = "" Then Exit Sub
   
    Set My_Connection = CreateObject("AdoDB.Connection")
    First_Date = TextBox2
    Last_Date = TextBox3
   
    My_Connection.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
    ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;Hdr=No"""
   
    My_Query = "Select Distinct F5,F6 From [veri$A2:G] Where F3 Between " & _
                CLng(First_Date) & " And " & CLng(Last_Date) & ""
   
    Set My_Recordset = My_Connection.Execute(My_Query)
   
    On Error Resume Next
   
    With ListView1
        .ListItems.Clear
        Do While Not My_Recordset.EOF
            Set Liste = ListView1.ListItems.Add(, , My_Recordset.Fields(0).Value)
            Liste.SubItems(1) = My_Recordset.Fields(0).Value
            Liste.SubItems(2) = My_Recordset.Fields(1).Value
            My_Recordset.MoveNext
        Loop
    End With
   
    On Error GoTo 0
   
    My_Recordset.Close
    My_Connection.Close

    Set Liste = Nothing
    Set My_Recordset = Nothing
    Set My_Connection = Nothing
End Sub

Korhan bey teşekkürler, bu kodlar bende çalışıyor ve sonuç alıyorum.

walabi · 22 Haziran 2023

Merhaba

Daha önce cevap aldığım konuyla ilgili olarak ek bir yardıma ihtiyacım var. Öncelikle SQL sorgu tiplerini örneklerle açıklayan bir kaynak var mıdır internette. Varsa Link rica edeceğim. SQL hakim değilim.

Sorum ise şu: Ekli dosyada bir örnek mevcut. A:AE sütunları arasında veriler var.

Koda şunu demeye çalışıyorum. Şu değerler ile başlayan ve şu tarihler arasında olan stok kodlarının benzersiz değerlerini listele ( Korhan bey bu kısmı cevaplamıştı ) ve bu stok kodlarına ait en son alış bilgilerini ( son alış tarihi ile beraber fiyat, ünvan, fatura no, ... ) bu kodların yanına listele. Listeleme yeri listview1.

SQL sorgu şekline hakim olmadığı için sormaktayım. Bu tip soruya cevap verecek kod bileşimi nasıl olmalıdır.

Korhan Ayhan · 22 Haziran 2023

Merhaba,

Alttaki linkten faydalanabilirsiniz.

SQL kodları nasıl kullanılır? SQL kodları ile ilgili Türkçe kaynak sitesi

www.sqlkodlari.com

mühendisberke · 23 Haziran 2023

Yeni sütun aç aşağıdakini gir
=EĞER(VE(F1<=TarihBaşla;F1>= TarihSon);1;0)
Şimdi makro ile aralık dışı satırları silelim:

Sub SATIRSIL()
Dim iCon As Long
Dim jCon As Long
jCon = ActiveCell.Column
For iCon = 1000 To 1 Step -1
If Cells(iCon, jCon) = 0 Then
Rows(iCon).Delete
End If
Next
End Sub

Artık tarih aralığı dışında kalan kod yok.

walabi · 23 Haziran 2023

mühendisberke' Alıntı:
Yeni sütun aç aşağıdakini gir
=EĞER(VE(F1<=TarihBaşla;F1>= TarihSon);1;0)
Şimdi makro ile aralık dışı satırları silelim:

Sub SATIRSIL()
Dim iCon As Long
Dim jCon As Long
jCon = ActiveCell.Column
For iCon = 1000 To 1 Step -1
If Cells(iCon, jCon) = 0 Then
Rows(iCon).Delete
End If
Next
End Sub

Artık tarih aralığı dışında kalan kod yok.

Konu farklı,

Excel sayfası üzerinde işlem yapmayı önermektesiniz sanırım. Ancak ben, excel sayfasını veri tabanı gibi kullanıyorum. Amacım sayfa üzerindeki verileri çeşitli sorgular ile listview1 e almak.

Listview İki Tarih Arası Benzersiz Değer Filtreleme

walabi

walabi

Ekli dosyalar

Korhan Ayhan

Administrator

walabi

Ekli dosyalar

Korhan Ayhan

Administrator

walabi

Korhan Ayhan

Administrator

Korhan Ayhan

Administrator

Korhan Ayhan

Administrator

walabi

Korhan Ayhan

Administrator

walabi

Ekli dosyalar

walabi

Ekli dosyalar

Korhan Ayhan

Administrator

SQL kodları nasıl kullanılır? SQL kodları ile ilgili Türkçe kaynak sitesi

mühendisberke

walabi