Soru Ara Bul Kodu Çok Yavaş Çalışıyor

Katılım
7 Şubat 2021
Mesajlar
455
Excel Vers. ve Dili
2010, Türkiye
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


https://dosyam.org/Zxe/Dosya.xlsb



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
 
Katılım
7 Şubat 2021
Mesajlar
455
Excel Vers. ve Dili
2010, Türkiye
Merhabalar;
Sayın değerli hocalarım. Konuya destek olabilir misiniz?
 
Üst