• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Userformda arama hakkında

Katılım
17 Ocak 2008
Mesajlar
183
Excel Vers. ve Dili
2003
Merhaba arkadaşlar
BUL adlı userform var burada iki adet optionbutton var
sicile ve ürün koduna göre KAYIT adlı sheet de arama yapılıyor. Her iki seçenek de 256 .satıra kadar arama yapılıyor. Halbuki ben 65536 satırda arama yapılsın istiyorum bir türlü yapamadım.

Bir başka isteğim ise sicile göre seçenek düğmesi seçildiğinde Textbox2 ve Textbox3 nesnesine girilen tarih aralığındaki kayıtları bulması örneğin textbox1 e sicil no 12588 girilsin tarih aralığıda sırayla 01.11.2010 - 01.12.2010 girilsin butona tıkladığımda bu tarihler arasındaki belirtilen sicile ait kayıtlar aransın

Yardımlarınızı rica ediyorum
 

Ekli dosyalar

Kodlarınızı aşağıdaki değiştirip, deneyin.

Kod:
 Private Sub CommandButton1_Click()
Dim k As Range, adr As String, x As Long, Sh As Worksheet
If OptionButton1 = Empty Then
If OptionButton2 = Empty Then
MsgBox "LÜTFEN SİCİL YADA ÜRÜN KODUNA GÖRE TERCİHİNİZİ YAPINIZ", vbExclamation, "Dikkat !"
Exit Sub
End If
End If
If OptionButton1 = Empty Then
If TextBox1 = "" Then
MsgBox "LÜTFEN ÜRÜN KODUNU GİRİNİZ"
Exit Sub
End If
End If
If OptionButton2 = Empty Then
If TextBox1 = "" Then
MsgBox "LÜTFEN SİCİL NUMARASINI GİRİNİZ"
Exit Sub
End If
End If
ListBox1.RowSource = ""
ListBox1.Clear
ListBox1.ColumnCount = 2
ListBox1.ColumnWidths = "85;55"
ListBox2.RowSource = ""
ListBox2.Clear
ListBox2.ColumnCount = 2
ListBox2.ColumnWidths = "85;55"
ListBox3.RowSource = ""
ListBox3.Clear
ListBox3.ColumnCount = 2
ListBox3.ColumnWidths = "85;55"
If TextBox1.Text = "" Then Exit Sub
Set Sh = Sheets("KAYIT")
If OptionButton1.Value = True Then
j = 2
ekle = 0
ekle1 = 1
If Not IsDate(TextBox2.Text) And Not IsDate(TextBox3.Text) Then
MsgBox "TARİHLER DE EKSİKLİK VAR"
Exit Sub
End If
Else
j = 3
ekle = -1
ekle1 = 0

End If
For i = 1 To 3
x = 0
Set k = Sh.Columns(j).Find(TextBox1.Text, , xlValues, xlWhole)
If Not k Is Nothing Then
adr = k.Address
Do
If OptionButton1.Value = False Then
GoTo n
Else
If CLng(CDate(Sh.Cells(k.Row, j - 1 + ekle))) >= CLng(CDate(TextBox2)) And CLng(CDate(Sh.Cells(k.Row, j - 1 + ekle))) <= CLng(CDate(TextBox3)) Then
n:
Controls("ListBox" & i).AddItem
Controls("ListBox" & i).List(x, 0) = Format(Sh.Cells(k.Row, j - 1 + ekle).Value, "dd.mm.yyyy hh:mm")
Controls("ListBox" & i).List(x, 1) = Sh.Cells(k.Row, j + ekle + ekle1).Value
x = x + 1
End If
End If
Set k = Sh.Columns(j).FindNext(k)
Loop While Not k Is Nothing And k.Address <> adr

Label6.Caption = "Listelenen : " & Format(ListBox1.ListCount, "#,##0")
Label7.Caption = "Listelenen : " & Format(ListBox2.ListCount, "#,##0")
Label8.Caption = "Listelenen : " & Format(ListBox3.ListCount, "#,##0")
End If
j = j + 4
Next
MsgBox "ARAMA SONUÇLANDI"

End Sub
 
alternatif olarak aşağıdaki dosyaya bakarmısınız.

Kod:
Private Sub CommandButton1_Click()
Dim say1 As Long, say2 As Long, say3 As Long, Sh As Worksheet
If OptionButton1 = Empty Then
If OptionButton2 = Empty Then
MsgBox "LÜTFEN SİCİL YADA ÜRÜN KODUNA GÖRE TERCİHİNİZİ YAPINIZ", vbExclamation, "Dikkat !"
Exit Sub
End If
End If
If OptionButton1 = Empty Then
If TextBox1 = "" Then
MsgBox "LÜTFEN ÜRÜN KODUNU GİRİNİZ"
Exit Sub
End If
End If
If OptionButton2 = Empty Then
If TextBox1 = "" Then
MsgBox "LÜTFEN SİCİL NUMARASINI GİRİNİZ"
Exit Sub
End If
End If

ListBox1.Clear
ListBox1.ColumnCount = 2
ListBox1.ColumnWidths = "85;55"
ListBox2.Clear
ListBox2.ColumnCount = 2
ListBox2.ColumnWidths = "85;55"
ListBox3.Clear
ListBox3.ColumnCount = 2
ListBox3.ColumnWidths = "85;55"
If TextBox1.Text = "" Then Exit Sub
Set Sh = Sheets("KAYIT")
On Error Resume Next
baslangic_tar = TextBox2.Text
bitis_tar = TextBox3.Text
If IsDate(bitis_tar) = False Then
MsgBox "değer tarih değil"
Exit Sub
End If
If IsDate(baslangic_tar) = False Then
MsgBox "değer tarih değil"
Exit Sub
End If
If WorksheetFunction.CountA(Sh.Cells) > 0 Then
sat = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
sut = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Else
Exit Sub
End If

With Sh.Range(Cells(2, 1), Cells(sat, sut))
Set d = .Find(What:=TextBox1.Text, After:=.Cells(.Cells.Count), LookIn:=xlValues, lookat:=xlWhole, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
If Not d Is Nothing Then
FirstAddress = d.Address
Do
If OptionButton1.Value = True Then
If d.Column = 2 Then
yer = CDate(Format(Sh.Cells(d.Row, 1).Value, "dd.mm.yyyy"))
If CDate(baslangic_tar) <= yer And CDate(bitis_tar) >= yer Then
ListBox1.AddItem
ListBox1.List(say1, 0) = Format(Sh.Cells(d.Row, 1).Value, "dd.mm.yyyy hh:mm")
ListBox1.List(say1, 1) = Sh.Cells(d.Row, 3).Value
say1 = say1 + 1
End If
End If
If d.Column = 6 Then
yer = CDate(Format(Sh.Cells(d.Row, 5).Value, "dd.mm.yyyy"))
If CDate(baslangic_tar) <= yer And CDate(bitis_tar) >= yer Then
ListBox2.AddItem
ListBox2.List(say2, 0) = Format(Sh.Cells(d.Row, 5).Value, "dd.mm.yyyy hh:mm")
ListBox2.List(say2, 1) = Sh.Cells(d.Row, 7).Value
say2 = say2 + 1
End If
End If
If d.Column = 10 Then
yer = CDate(Format(Sh.Cells(d.Row, 9).Value, "dd.mm.yyyy"))
If CDate(baslangic_tar) <= yer And CDate(bitis_tar) >= yer Then
ListBox3.AddItem
ListBox3.List(say3, 0) = Format(Sh.Cells(d.Row, 9).Value, "dd.mm.yyyy hh:mm")
ListBox3.List(say3, 1) = Sh.Cells(d.Row, 11).Value
say3 = say3 + 1
End If
End If
End If
If OptionButton2.Value = True Then
If d.Column = 3 Then
ListBox1.AddItem
ListBox1.List(say1, 0) = Format(Sh.Cells(d.Row, 1).Value, "dd.mm.yyyy hh:mm")
ListBox1.List(say1, 1) = Sh.Cells(d.Row, 2).Value
say1 = say1 + 1
End If
If d.Column = 7 Then
ListBox2.AddItem
ListBox2.List(say2, 0) = Format(Sh.Cells(d.Row, 5).Value, "dd.mm.yyyy hh:mm")
ListBox2.List(say2, 1) = Sh.Cells(d.Row, 6).Value
say2 = say2 + 1
End If
If d.Column = 11 Then
ListBox3.AddItem
ListBox3.List(say3, 0) = Format(Sh.Cells(d.Row, 9).Value, "dd.mm.yyyy hh:mm")
ListBox3.List(say3, 1) = Sh.Cells(d.Row, 10).Value
say3 = say3 + 1
End If
End If

Set d = .FindNext(d)
Loop While Not d Is Nothing And d.Address <> FirstAddress
End If
End With
Set Sh = Nothing

Label6.Caption = "Listelenen : " & Format(ListBox1.ListCount, "#,##0")
Label7.Caption = "Listelenen : " & Format(ListBox2.ListCount, "#,##0")
Label8.Caption = "Listelenen : " & Format(ListBox3.ListCount, "#,##0")

MsgBox "ARAMA SONUÇLANDI"
End Sub
 

Ekli dosyalar

Sn Halit3 sizede ayrıca teşekkür ederim daha öncede bu örneğin şekillenmesinde yardımcı olmuştunuz yalnız bu örnekte ürün koduna göre arama seçeneği seçildiğinde tarih aralaığı belirtmek istemiyorum aranacak kod 3 ayrı kontrol noktasında sadece 1 tane olacağından tarih ile sınırlandırmamak gerekiyo,sicile göre arandığında onlarca kayıt bulunacağından sadece belirli tarih aralığı aransın istedim bu bağlamda Sn Husgvarna nın kodu işimi görüyor
Sizden ricam vaktiniz varsa tabi sizin konu başlığınıolan dtpicker nesnesi ile alakalı
Şöyle ki siteden aldığım anlattığınız yöntemle DTpicker nesnesini userforma eklemiş VEtarihleride bu yöntemle giriyorum WİNDOWS system32 klasöründe mscomct2.ocx dosyası var anlattığınız gibi adımları yapıyorum son olarak TOLBOOX nesnesinde DTpicker nesnesi görünüyo ancak userforma ekleyemiyorum "classfactory"istenen sınıfı sağlamıyor hatası çıkıyor halbuki önceden sorunsuz çalışıyordu bu konuda aydınlatabilirseniz çok mutlu olacam teşekkürler
 
3 nolu mesajdaki dosyayı güncelledim.

diğer sorunuz için aşağıdaki linkden MSCOMCTL.OCX bu dosyayı indirin ve yeniden bir daha yükleyin. başkada bir şey gelmiyor aklıma

http://www.ocxdump.com/ocx-files/A_1.html
 
Geri
Üst