• DİKKAT

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

Soru Arama ve Kaydet Makrosunda Düzenleme

  • Konbuyu başlatan Konbuyu başlatan Hsn55
  • Başlangıç tarihi Başlangıç tarihi
H

Hsn55

Katılım
7 Şubat 2021
Mesajlar
595
Excel Vers. ve Dili
2010, Türkiye
Ekli dosyada userform üzerinde ki Texbox23 hücresi ile arama yaptığım zaman aşağıdaki sorunlarla karşılaşıyorum.
1-Arama yapılınca Listbox1'in ilk satırrındaki başlıklar gizleniyor. (S.No,Adı Soyadı,Dava no gibi)
2-Örneğin Texbox23 te arama yapıp; listbox1 de seçili satırda iken Combobox ve Textboxlara veri girip kaydet dediğimde lisbox1 de seçili satır ve süzülmüş halinde kalmıyor.
3-Birde arama işlemi hızlandırma imkanı var mı?
Yardımcı olursanız sevinirim.
Dosya Link:

İndir Dava xlsb

Dosyayı indir Dava xlsb
dosya.co
Ekran Resmi:

İndir Ekran Alıntısı JPG

Dosyayı indir Ekran Alıntısı JPG
dosya.co
Kod: 
Private Sub TextBox23_Change()

If dur = 1 Then Exit Sub
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Dim SyfKyt As Worksheet
Dim alan As Variant, sonuc() As Variant, finalArr() As Variant
Dim ara As String
Dim i As Long, j As Long, k As Long
Dim bul As Long
Dim ss As Long, colSay As Long

Set SyfKyt = Worksheets("KAYITLAR")

ss = SyfKyt.Cells(SyfKyt.Rows.Count, 1).End(xlUp).Row
If ss < 4 Then Exit Sub

alan = SyfKyt.Range("A4:GR" & ss).Value

colSay = UBound(alan, 2)

ara = UCase(TextBox23.Value)

ReDim sonuc(1 To UBound(alan, 1), 1 To colSay)

bul = 0

For i = 1 To UBound(alan, 1)

    For j = 2 To colSay

        If ara = "" Or InStr(1, UCase(alan(i, j)), ara, vbTextCompare) > 0 Then

            bul = bul + 1

            For k = 1 To colSay
                sonuc(bul, k) = alan(i, k)
            Next k

            Exit For

        End If

    Next j

Next i

' SONUÇ YOKSA
If bul = 0 Then
    With ListBox1
        .RowSource = vbNullString
        .Clear
        .ColumnCount = 1
        .AddItem "KAYIT YOK"
    End With
    Exit Sub
End If

' DİZİYİ KES
ReDim finalArr(1 To bul, 1 To colSay)

For i = 1 To bul
    For j = 1 To colSay
        finalArr(i, j) = sonuc(i, j)
    Next j
Next i

' ?? LISTBOX RESET + YÜKLEME (EN STABİL KISIM)
With ListBox1
    .RowSource = vbNullString
    DoEvents
    .ColumnCount = colSay
    .List = finalArr
End With

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
End Sub
Kod: 
Sub Kaydet() 'KAYDET
    On Error Resume Next
    Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
    No = TextBox1.Value
    LbRwS = Me.ListBox1.RowSource
    SuzMu = InStr(1, LbRwS, "suz", vbTextCompare)
    If No = Empty Then MsgBox "DAVA TAKİP NO BOŞ OLMAZ!", vbCritical, "D İ K K A T":    Exit Sub
    Set SyfKyt = ThisWorkbook.Worksheets("KAYITLAR")
    Set SyfTzm = ThisWorkbook.Worksheets("TAZMİNATGİRİŞİ")
           ss = SyfKyt.Cells(Rows.Count, 1).End(xlUp).Row: If ss < 4 Then ss = 4
             x = Application.Match(No, SyfKyt.Range("B:B"), 0)
        If Not IsError(x) Then xMsg = "Veri Güncellensin mi?" Else xMsg = "Yeni Kayıt Eklensin mi?": x = ss + 1
If MsgBox(xMsg, vbInformation + vbYesNo + vbDefaultButton2, "D İ K K A T") = vbNo Then Exit Sub
    ListBox1.RowSource = ""
    SyfKyt.Cells(x, 1) = Format(x - 3, "@")
    SyfKyt.Cells(x, 2) = Format(TextBox1.Value, "@")
    SyfKyt.Cells(x, 3) = Format(TextBox2.Value, "@")
    SyfKyt.Cells(x, 4) = ComboBox1.Value
    SyfKyt.Cells(x, 5) = ComboBox2.Value
    SyfKyt.Cells(x, 6) = ComboBox3.Value
    SyfKyt.Cells(x, 7) = TextBox3.Value
    SyfKyt.Cells(x, 8) = TextBox4.Value
    SyfKyt.Cells(x, 9) = Format(TextBox5.Value, "@")
    SyfKyt.Cells(x, 10) = Format(TextBox6.Value, "@")
    SyfKyt.Cells(x, 11) = TextBox7.Value
    SyfKyt.Cells(x, 12) = ComboBox40.Value
    SyfKyt.Cells(x, 13) = ComboBox4.Value
    SyfKyt.Cells(x, 14) = ComboBox5.Value
    SyfKyt.Cells(x, 15) = ComboBox6.Value
    SyfKyt.Cells(x, 16) = TextBox9.Value
    SyfKyt.Cells(x, 17) = Format(TextBox10.Value, "@")
    SyfKyt.Cells(x, 18) = Format(TextBox11.Value, "@")
    SyfKyt.Cells(x, 19) = Format(TextBox12.Value, "@")
    SyfKyt.Cells(x, 20) = ComboBox7.Value
    SyfKyt.Cells(x, 21) = ComboBox8.Value
    SyfKyt.Cells(x, 22) = Format(TextBox13.Value, "@")
    SyfKyt.Cells(x, 27) = ComboBox9.Value
    SyfKyt.Cells(x, 28) = ComboBox10.Value
    SyfKyt.Cells(x, 29) = ComboBox11.Value
    SyfKyt.Cells(x, 30) = ComboBox12.Value
    SyfKyt.Cells(x, 31) = ComboBox13.Value
    SyfKyt.Cells(x, 32) = TextBox18.Value
    SyfKyt.Cells(x, 18) = CDate(TextBox11)
    SyfKyt.Cells(x, 33) = Format(TextBox19.Value, "@")
    SyfKyt.Cells(x, 34) = Format(TextBox20.Value, "@")
    SyfKyt.Cells(x, 35) = Format(TextBox28.Value, "@")
    SyfKyt.Cells(x, 23) = SyfTzm.Range("M22")
    SyfKyt.Cells(x, 24) = SyfTzm.Range("N22")
    SyfKyt.Cells(x, 25) = SyfTzm.Range("O22")
    SyfKyt.Cells(x, 26) = SyfTzm.Range("K22")
    SyfKyt.Cells(x, 37) = SyfTzm.Range("I12")
    SyfKyt.Cells(x, 38) = SyfTzm.Range("I13")
    SyfKyt.Cells(x, 39) = SyfTzm.Range("I14")
    SyfKyt.Cells(x, 40) = SyfTzm.Range("I15")
    SyfKyt.Cells(x, 41) = SyfTzm.Range("I16")
    SyfKyt.Cells(x, 42) = SyfTzm.Range("I17")
    SyfKyt.Cells(x, 43) = SyfTzm.Range("I18")
    SyfKyt.Cells(x, 44) = SyfTzm.Range("I19")
    SyfKyt.Cells(x, 45) = SyfTzm.Range("I20")
    SyfKyt.Cells(x, 46) = SyfTzm.Range("I21")
    SyfKyt.Cells(x, 47) = SyfTzm.Range("J12")
    SyfKyt.Cells(x, 48) = SyfTzm.Range("J13")
    SyfKyt.Cells(x, 49) = SyfTzm.Range("J14")
    SyfKyt.Cells(x, 50) = SyfTzm.Range("J15")
    SyfKyt.Cells(x, 51) = SyfTzm.Range("J16")
    SyfKyt.Cells(x, 52) = SyfTzm.Range("J17")
    SyfKyt.Cells(x, 53) = SyfTzm.Range("J18")
    SyfKyt.Cells(x, 54) = SyfTzm.Range("J19")
    SyfKyt.Cells(x, 55) = SyfTzm.Range("J20")
    SyfKyt.Cells(x, 56) = SyfTzm.Range("J21")
    SyfKyt.Cells(x, 57) = SyfTzm.Range("K12")
    SyfKyt.Cells(x, 58) = SyfTzm.Range("K13")
    SyfKyt.Cells(x, 59) = SyfTzm.Range("K14")
    SyfKyt.Cells(x, 60) = SyfTzm.Range("K15")
    SyfKyt.Cells(x, 61) = SyfTzm.Range("K16")
    SyfKyt.Cells(x, 62) = SyfTzm.Range("K17")
    SyfKyt.Cells(x, 63) = SyfTzm.Range("K18")
    SyfKyt.Cells(x, 64) = SyfTzm.Range("K19")
    SyfKyt.Cells(x, 65) = SyfTzm.Range("K20")
    SyfKyt.Cells(x, 66) = SyfTzm.Range("K21")
    SyfKyt.Cells(x, 67) = SyfTzm.Range("L12")
    SyfKyt.Cells(x, 68) = SyfTzm.Range("L13")
    SyfKyt.Cells(x, 69) = SyfTzm.Range("L14")
    SyfKyt.Cells(x, 70) = SyfTzm.Range("L15")
    SyfKyt.Cells(x, 71) = SyfTzm.Range("L16")
    SyfKyt.Cells(x, 72) = SyfTzm.Range("L17")
    SyfKyt.Cells(x, 73) = SyfTzm.Range("L18")
    SyfKyt.Cells(x, 74) = SyfTzm.Range("L19")
    SyfKyt.Cells(x, 75) = SyfTzm.Range("L20")
    SyfKyt.Cells(x, 76) = SyfTzm.Range("L21")
    SyfKyt.Cells(x, 77) = SyfTzm.Range("M12")
    SyfKyt.Cells(x, 78) = SyfTzm.Range("M13")
    SyfKyt.Cells(x, 79) = SyfTzm.Range("M14")
    SyfKyt.Cells(x, 80) = SyfTzm.Range("M15")
    SyfKyt.Cells(x, 81) = SyfTzm.Range("M16")
    SyfKyt.Cells(x, 82) = SyfTzm.Range("M17")
    SyfKyt.Cells(x, 83) = SyfTzm.Range("M18")
    SyfKyt.Cells(x, 84) = SyfTzm.Range("M19")
    SyfKyt.Cells(x, 85) = SyfTzm.Range("M20")
    SyfKyt.Cells(x, 86) = SyfTzm.Range("M21")
    SyfKyt.Cells(x, 87) = SyfTzm.Range("N12")
    SyfKyt.Cells(x, 88) = SyfTzm.Range("N13")
    SyfKyt.Cells(x, 89) = SyfTzm.Range("N14")
    SyfKyt.Cells(x, 90) = SyfTzm.Range("N15")
    SyfKyt.Cells(x, 91) = SyfTzm.Range("N16")
    SyfKyt.Cells(x, 92) = SyfTzm.Range("N17")
    SyfKyt.Cells(x, 93) = SyfTzm.Range("N18")
    SyfKyt.Cells(x, 94) = SyfTzm.Range("N19")
    SyfKyt.Cells(x, 95) = SyfTzm.Range("N20")
    SyfKyt.Cells(x, 96) = SyfTzm.Range("N21")
    SyfKyt.Cells(x, 97) = SyfTzm.Range("O12")
    SyfKyt.Cells(x, 98) = SyfTzm.Range("O13")
    SyfKyt.Cells(x, 99) = SyfTzm.Range("O14")
    SyfKyt.Cells(x, 100) = SyfTzm.Range("O15")
    SyfKyt.Cells(x, 101) = SyfTzm.Range("O16")
    SyfKyt.Cells(x, 102) = SyfTzm.Range("O17")
    SyfKyt.Cells(x, 103) = SyfTzm.Range("O18")
    SyfKyt.Cells(x, 104) = SyfTzm.Range("O19")
    SyfKyt.Cells(x, 105) = SyfTzm.Range("O20")
    SyfKyt.Cells(x, 106) = SyfTzm.Range("O21")
    SyfKyt.Cells(x, 107) = SyfTzm.Range("L22")
    SyfKyt.Cells(x, 108) = SyfTzm.Range("P22")
    SyfKyt.Cells(x, 165) = SyfTzm.Range("R12")
    SyfKyt.Cells(x, 166) = SyfTzm.Range("S12")
    SyfKyt.Cells(x, 167) = SyfTzm.Range("T12")
    SyfKyt.Cells(x, 168) = SyfTzm.Range("U12")
    SyfKyt.Cells(x, 169) = SyfTzm.Range("V12")
    SyfKyt.Cells(x, 170) = SyfTzm.Range("W12")
    SyfKyt.Cells(x, 171) = SyfTzm.Range("R13")
    SyfKyt.Cells(x, 172) = SyfTzm.Range("S13")
    SyfKyt.Cells(x, 173) = SyfTzm.Range("T13")
    SyfKyt.Cells(x, 174) = SyfTzm.Range("U13")
    SyfKyt.Cells(x, 175) = SyfTzm.Range("V13")
    SyfKyt.Cells(x, 176) = SyfTzm.Range("W13")
    SyfKyt.Cells(x, 177) = SyfTzm.Range("R14")
    SyfKyt.Cells(x, 178) = SyfTzm.Range("S14")
    SyfKyt.Cells(x, 179) = SyfTzm.Range("T14")
    SyfKyt.Cells(x, 180) = SyfTzm.Range("U14")
    SyfKyt.Cells(x, 181) = SyfTzm.Range("V14")
    SyfKyt.Cells(x, 182) = SyfTzm.Range("W14")
    SyfKyt.Cells(x, 183) = SyfTzm.Range("R15")
    SyfKyt.Cells(x, 184) = SyfTzm.Range("S15")
    SyfKyt.Cells(x, 185) = SyfTzm.Range("T15")
    SyfKyt.Cells(x, 186) = SyfTzm.Range("U15")
    SyfKyt.Cells(x, 187) = SyfTzm.Range("V15")
    SyfKyt.Cells(x, 188) = SyfTzm.Range("W15")
    SyfKyt.Cells(x, 189) = SyfTzm.Range("R16")
    SyfKyt.Cells(x, 190) = SyfTzm.Range("S16")
    SyfKyt.Cells(x, 191) = SyfTzm.Range("T16")
    SyfKyt.Cells(x, 192) = SyfTzm.Range("U16")
    SyfKyt.Cells(x, 193) = SyfTzm.Range("V16")
    SyfKyt.Cells(x, 194) = SyfTzm.Range("W16")
    SyfKyt.Cells(x, 195) = SyfTzm.Range("S17")
    SyfKyt.Cells(x, 196) = SyfTzm.Range("T17")
    SyfKyt.Cells(x, 197) = SyfTzm.Range("U17")
    SyfKyt.Cells(x, 198) = SyfTzm.Range("V17")
    SyfKyt.Cells(x, 199) = SyfTzm.Range("W17")
    SyfKyt.Cells(x, 200) = SyfTzm.TextBox1.Value
    SyfKyt.Cells(x, 109) = ComboBox15.Value
    SyfKyt.Cells(x, 110) = ComboBox16.Value
    SyfKyt.Cells(x, 111) = ComboBox17.Value
    SyfKyt.Cells(x, 112) = ComboBox18.Value
    SyfKyt.Cells(x, 113) = ComboBox19.Value
    SyfKyt.Cells(x, 114) = ComboBox20.Value
    SyfKyt.Cells(x, 115) = ComboBox21.Value
    SyfKyt.Cells(x, 116) = ComboBox22.Value
    SyfKyt.Cells(x, 117) = ComboBox23.Value
    SyfKyt.Cells(x, 118) = ComboBox24.Value
    SyfKyt.Cells(x, 119) = ComboBox25.Value
    SyfKyt.Cells(x, 120) = ComboBox26.Value
    SyfKyt.Cells(x, 121) = ComboBox27.Value
    SyfKyt.Cells(x, 122) = ComboBox28.Value
    SyfKyt.Cells(x, 123) = ComboBox39.Value
    SyfKyt.Cells(x, 124) = TextBox27.Value
    SyfKyt.Cells(x, 125) = TextBox22.Value
    SyfKyt.Cells(x, 126) = TextBox21.Value
    SyfKyt.Cells(x, 128) = TextBox29.Value
    SyfKyt.Cells(x, 129) = TextBox30.Value
    SyfKyt.Cells(x, 130) = TextBox31.Value
    SyfKyt.Cells(x, 131) = ComboBox41.Value
    SyfKyt.Cells(x, 132) = ComboBox42.Value
    SyfKyt.Cells(x, 133) = ComboBox43.Value
    SyfKyt.Cells(x, 134) = ComboBox44.Value
    SyfKyt.Cells(x, 135) = ComboBox45.Value
    SyfKyt.Cells(x, 136) = ComboBox46.Value
    SyfKyt.Cells(x, 137) = ComboBox47.Value
    SyfKyt.Cells(x, 138) = ComboBox48.Value
    SyfKyt.Cells(x, 139) = ComboBox49.Value
    SyfKyt.Cells(x, 140) = ComboBox50.Value
    SyfKyt.Cells(x, 141) = ComboBox51.Value
    SyfKyt.Cells(x, 142) = ComboBox52.Value
    SyfKyt.Cells(x, 143) = ComboBox53.Value
    SyfKyt.Cells(x, 144) = ComboBox54.Value
    SyfKyt.Cells(x, 145) = ComboBox55.Value
    SyfKyt.Cells(x, 146) = ComboBox56.Value
    SyfKyt.Cells(x, 147) = ComboBox57.Value
    SyfKyt.Cells(x, 148) = ComboBox58.Value
    SyfKyt.Cells(x, 149) = ComboBox59.Value
    SyfKyt.Cells(x, 150) = ComboBox60.Value
    SyfKyt.Cells(x, 151) = ComboBox61.Value
    SyfKyt.Cells(x, 152) = ComboBox62.Value
    SyfKyt.Cells(x, 153) = ComboBox63.Value
    SyfKyt.Cells(x, 154) = ComboBox64.Value
If SuzMu = 0 Then
    ss = SyfKyt.Cells(Rows.Count, 1).End(xlUp).Row
    If ss < 4 Then ss = 4
    ListBox1.RowSource = "KAYITLAR!A4:AJ" & ss
'    ListBox1 = x - 3
Else

If aramaTxtBox = 23 Then TextBox23_Change
End If
On Error Resume Next
ListBox1 = x - 3
 Time2 = Now
 timeElapsed = Format(Time2 - Time1, "ss") & " Saniye"
 MsgBox "İşlem süresi: " & timeElapsed, vbInformation

Call FORMÜL
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
End Sub
 
Merhaba,

Daha önce işlenmiş konuların linkini paylaşıyorum. İnceleyerek kendi dosyanıza uyarlamayı deneyebilirsiniz.

Korhan Ayhan

Konu içindeki mesaj 'ListBox' ta sütun başlıklarını manuel ekleme'

Bahsettiğim konuyu buldum. İnceleyebilirsiniz.

ADO sorgusuna Userform Listbox da başlık eklemek

Merhaba, Çok aramama rağmen, sorgu yaptığım tablonun başlıklarını Userform listbox listesinde RS.GetRows komutu ile beraber kullanamadım. Farklı cevaplar olmasına rağmen, testlerimde RS.GetRows un daha hızlı sonuç aktardığını gördüğüm için bun uygun çözüm bulmak istedim. Biraz uğraştırıcı...
www.excel.web.tr www.excel.web.tr

Tasarım

Çözüldü Konu içindeki mesaj 'Listbox Yavaş Yükleme Sorunu'

Korhan Ayhan' Alıntı:
Merhaba,

Verileri Userform açılışında ListBox nesnesine yüklemek için döngüye gerek yok.. Döngüler veri sayısı arttıkça yavaş performans oluşmasına sebep olur.

En hızlı yöntem RowSource yöntemi olacaktır.

C++: 
Private Sub UserForm_Initialize()
    Dim My_Column As Integer, No As String, X As Integer

    With ListBox1
        .ColumnCount = 4
        .RowSource = "Sayfa1!A2:D" & Cells(Rows.Count, 1).End(3).Row

        My_Column = Cells(1, Columns.Count).End(1).Column
    
        For X = 1 To My_Column
            No = No & CLng(Columns(X).Width) & ";"
        Next...
Genişletmek için tıkla ...
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst