Merhabalar;
Ekli linkteki dosyada ComboBox14 ten seçmiş olduğum veriyi TextBox24 ile kayıtlar sayfasında A4:AJ hücreleri arasında Seçili Sütunda aratıp buluyorum. TextBox23 ile de A4:AJ hücreleri arasında Tüm hücrelerde aratıp buluyorum. Fakat tümünde aratma yaptığımda bazen buluyor. Bazen ise bulmuyor. Kodlar her iki şarta göre aratma yaptığımda arama geç çalışıyor. İleriki zamanlarda kayıtları çoğalacağından dolayı arama da haliyle geç olacak. Bu iki ara-bul kodunun hızlanması için makroda ne gibi bir değişiklik yada farklı bir makro ile nasıl sağlayabiliriz. Yardımcı olursanız sevinirim. Saygılarımla
Ekli linkteki dosyada ComboBox14 ten seçmiş olduğum veriyi TextBox24 ile kayıtlar sayfasında A4:AJ hücreleri arasında Seçili Sütunda aratıp buluyorum. TextBox23 ile de A4:AJ hücreleri arasında Tüm hücrelerde aratıp buluyorum. Fakat tümünde aratma yaptığımda bazen buluyor. Bazen ise bulmuyor. Kodlar her iki şarta göre aratma yaptığımda arama geç çalışıyor. İleriki zamanlarda kayıtları çoğalacağından dolayı arama da haliyle geç olacak. Bu iki ara-bul kodunun hızlanması için makroda ne gibi bir değişiklik yada farklı bir makro ile nasıl sağlayabiliriz. Yardımcı olursanız sevinirim. Saygılarımla
Kod:
Private Sub TextBox23_AfterUpdate() 'TÜM KAYITLARDA ARAMA YAPAR
On Error Resume Next
If dur = 1 Then Exit Sub
Set SyfKyt = Worksheets("KAYITLAR")
ss = SyfKyt.Cells(Rows.Count, 1).End(xlUp).Row
Set alan = SyfKyt.Range("A4:AJ" & ss)
sut = alan.Find(What:="*" & TextBox23 & "*", LookIn:=xlValues).Column
If sut = Empty Then MsgBox "Veri bulunamadı.", vbInformation, "**********.com": Exit Sub
dur = 1
ComboBox14.ListIndex = sut - 1
dur = Empty
TextBox24 = TextBox23
Application.CutCopyMode = False
sut = Empty
alan = Empty
End Sub
Kod:
Private Sub TextBox24_Change() 'COMBOBOX14 SEÇİLİ KAYITTA ARAMA YAPAR
On Error Resume Next
If dur = 1 Then Exit Sub
Application.ScreenUpdating = False
Application.CutCopyMode = False
' ListBox1.RowSource = Empty
Set SyfKyt = Worksheets("KAYITLAR")
Set sz = Worksheets("Suz")
dur = 1
TextBox23 = Empty
dur = Empty
ss = sz.Cells(Rows.Count, 1).End(xlUp).Row
If ss < 4 Then ss = 4
sz.Range("A4:AJ" & ss).ClearContents
ss = SyfKyt.Cells(Rows.Count, 1).End(xlUp).Row
If ss < 4 Then ss = 4
If ComboBox14 = Empty Then
MsgBox "Alan seçilmedi.", vbInformation, "**********.com"
GoTo 1
End If
If TextBox24 = Empty Then
ListBox1.RowSource = "KAYITLAR!A4:AJ" & ss
' MsgBox "Arama kriteri belirtilmedi.", vbInformation, "**********.com"
GoTo 1
End If
a = "*" & TextBox24 & "*"
SyfKyt.Range("A3:$AJ" & ss).AutoFilter Field:=ComboBox14.ListIndex + 1, Criteria1:="*" & TextBox24 & "*"
SyfKyt.Range("A4:$AJ" & ss + 1).Copy
sz.Range("A4").PasteSpecial Paste:=xlPasteValues
ss = sz.Cells(Rows.Count, 1).End(xlUp).Row
If ss < 4 Then ss = 4
ListBox1.RowSource = Empty
ListBox1.RowSource = "Suz!A4:AJ" & ss
1:
SyfKyt.AutoFilterMode = False
Application.CutCopyMode = False
Application.ScreenUpdating = True
ListBox1.ListIndex = 0
End Sub