Aynı veri tekrarlanmasın

[HD1975]

Merhaba ;

Aşağıdaki dosyadaki kodlarda listbox'a aldığım verilerin aynı olanların
gelmemesi için kodda ne gibi bir değişikliğe ihtiyaç var.

Dosyadaki mantık şu ;

Sayfa2'deki veriler, sayfa8'de yok ise ve günün tarihinde beş gün öncesine ait
ise bu verileri listboxa aktarıyor.ama sayfa2'de birden fazla aynı kod olduğu için
mükerrer olarak geliyor.Bunların listboxta bir tane gözükmesi gerekiyor.


Saygılar

 

[Orion1]

Dosyanız ekte.

Private Sub UserForm_Initialize()
Dim i As Long, a As Long, bugun As Long
Dim tarih As Date
Dim kod As String
Dim kontrol As Boolean
On Local Error Resume Next
With Sayfa2
    a = .Range("c65536").End(3).Row
    bugun = CLng(CDate(Date)) - 5
    tarih = CDate(bugun)
    
    For i = 2 To a
        If WorksheetFunction.CountIf(.Range("C2:C" & i), .Cells(i, "C").Value) = 1 Then
        If FormatDateTime(.Cells(i, "G").Value) = tarih Then
            kod = CStr(.Cells(i, 3).Value)
            kontrol = Sayfa8.Range("a:a").Find(kod, , xlValues, , , xlNext, False)
            If kontrol = False Then
                With ListBox4
                    .ColumnCount = 4
                    .AddItem Sayfa2.Cells(i, 1).Value
                    .List(.ListCount - 1, 1) = Sayfa2.Cells(i, 2).Value
                    .List(.ListCount - 1, 2) = Sayfa2.Cells(i, 3).Value
                    .List(.ListCount - 1, 3) = FormatDateTime(Sayfa2.Cells(i, 7).Value, vbShortDate)
                End With
            End If
        End If
        kontrol = False
        End If
    Next i
End With

i = Empty: a = Empty: bugun = Empty
tarih = Empty
kod = vbNullString
End Sub

 

[HD1975]

Teşekkür ederim.

Evren Bey teşekkür ederim.

Bir ricam daha olacak mümkünse ;

bugun = CLng(CDate(Date)) - 5
tarih = CDate(bugun)

yukarıdaki kodda beş gün öncesi esas alınıyor.Burda şöyle bir koda ihtiyacım var.

Bugünün tarihinden,beş gün öncesinin esas alıp, o günden küçük ne kadar
vade varsa onlarıda görmem gerekiyor.

Yani Bugün 14.05.2009 - 5 - 09.05.2009 ve bu tarihten küçük olanlarda dahil.

Saygılar

 

[Orion1]

Evren Bey teşekkür ederim.

Bir ricam daha olacak mümkünse ;

bugun = CLng(CDate(Date)) - 5
tarih = CDate(bugun)

yukarıdaki kodda beş gün öncesi esas alınıyor.Burda şöyle bir koda ihtiyacım var.

Bugünün tarihinden,beş gün öncesinin esas alıp, o günden küçük ne kadar
vade varsa onlarıda görmem gerekiyor.

Yani Bugün 14.05.2009 - 5 - 09.05.2009 ve bu tarihten küçük olanlarda dahil.

Saygılar

İlgili satırdaki kodu aşağıdaki kod ile değiştiriniz.

If FormatDateTime(.Cells(i, "G").Value) <= tarih Then

 

[HD1975]

Teşekkür ederim.

Evren Bey ;

Herşey güzel oldu,ama ummadığım bir sorun çıktı.

Sanırım veriler fazla olduğundan çok kasıyor.

40000 adetin üzerinde veri var,yaklaşık beş dakikayı geçiyor.

Daha hızlı olacak bir yöntem olamazmı.

Saygılar

 

[HD1975]

Mükerrer Veri

Merhaba ;

Önceki sayfalarda Vba ile yapılan kodlamayı,çok fazla veri olduğundan
hız açısından sorun yaşamamak için Ado ile uyarladık.

Sorunumuz şu,Vba içindeki mükerrer veri gelmesin diye eklediğimiz kodu,
bunun içerisine olduğu gibi attım ama olmuyor.Buda nasıl bir düzenleme
gerekiyor.For döngüsü ile hata veriyor diğer türlü bir hata yok ama tepki
vermiyor.

Saygılar

Private Sub UserForm_Initialize()
On Local Error Resume Next
Dim bugun As Long, tarih As Long, kod As String, kontrol As Boolean
Dim con As Object, rs As Object, sorgu As String, i As Long, a As Long

Set sayfa = Sheets("sayfa9")

With Sayfa9
bugun = CLng(CDate(Date)) - 5
tarih = CLng(bugun)

Set con = CreateObject("adodb.connection")
con.Open "provider=microsoft.jet.oledb.4.0;data source=" & ThisWorkbook.FullName & _
";extended properties=""excel 8.0;hdr=yes"""
sorgu = "select * from [Sayfa9$] where clng(cdate(VADE_TARIHI)) <=" & tarih
Set rs = CreateObject("adodb.recordset")
rs.Open sorgu, con, 1, 1
Do While Not rs.EOF

'For i = 2 To a
If WorksheetFunction.CountIf(.Range("C2:C" & i), .Cells(i, "C").Value) = 1 Then
kod = CStr(rs("CARI_HESAP_KOD").Value)
kontrol = Sayfa8.Range("a:a").Find(kod, , xlValues, , , xlNext, False)
If kontrol = False Then

With ListBox4

.AddItem rs("ISYERI")
.List(.ListCount - 1, 1) = rs("CARI_HESAP_ADI")
.List(.ListCount - 1, 2) = rs("CARI_HESAP_KOD")
'.List(.ListCount - 1, 3) = FormatDateTime(rs("VADE_TARIHI").Value, vbShortDate)

End With
End If
End If
kontrol = False
rs.MoveNext
Loop
End With

MsgBox ""
i = Empty: a = Empty: bugun = Empty
tarih = Empty
kod = vbNullString
sorgu = vbNullString
Set con = Nothing
Set rs = Nothing
ListBox4.ColumnCount = 3
ListBox4.ColumnWidths = "68;110;50"
End Sub