• Web sitemizin SORU-CEVAP bölümünde dosya yüklemek ve dosya indirmek ÜCRETSİZ'dir.
    Gizlilik kapsamında, sadece site yöneticilerimizin ve üyenin kendisinin görebileceği ÜCRETLİ ÖZEL DESTEK alanımız mevcuttur.

Çözüldü Listbox Veri Süzme

kutman kaplan

Yeni Üye
Kullanıcı
Yaş
30
Versiyon
  1. Excel 2010
Sürüm
  1. 64 bit
Dil
  1. Türkçe

Reputation:

Merhaba ;

Data sayfasından a hücresinde bulunan 25.213 satır veri vardır.

Textbox kutusuna yazılan kelimelere benzer kelimeleri bularak listbox hücresine sıralıyor . Bu işlemi yapar iken 10-15 saniye bekliyorum yavaş çalışıyor .
Bu kod hızlandırılabilirmi .

Saygılarımla,
 



Forumumuzu reklamsız kullanmak, Hazır Excel Dosyaları indirmek ve web sitemize destek olmak için Hesap Yükseltme yapabilirsiniz. Detayları buradan inceleyebilir, hemen hesabınızı yükseltebilirsiniz.

Çözüm
Vakit çok geç oldu. sabahı ettik.
Halledemezseniz uygun zamanda ben veya başka bir arkadaşımız konuyla ilgilenecektir.

Şimdilik aşağıdaki konu sayfasında iki seçenekli bir çözüm var.
Bunlardan birini kendi dosyanıza uyarlamayı deneyin (sonuç alınamasa bile denemek faydalıdır).

Biri filtreleme (6 no'lu cevap), diğeri dizi yöntemidir (7 no'lu cevap).
Belgede VBA kısmı şifreliydi ve şifre konu sayfasında yazılı (gerekecektir).

kutman kaplan

Yeni Üye
Kullanıcı
Yaş
30
Versiyon
  1. Excel 2010
Sürüm
  1. 64 bit
Dil
  1. Türkçe

Reputation:

C++:
Sub KayıtlarıAl()

Dim KayıtSayısı, Satır As Variant
ListBox1.Clear
KayıtSayısı = Sheets("Data").Cells(Rows.Count, "A").End(xlUp).Row
For Satır = 3 To KayıtSayısı
    If InStr(UCase(Sheets("Data").Range("a" & Satır)), TextBox1.Value) > 0 Then
       ListBox1.AddItem Sheets("Data").Range("a" & Satır)
    End If
Next Satır

End Sub


Private Sub Frame1_Click()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Private Sub ListBox1_Click()

ActiveCell.Value = ListBox1.Value

End Sub

Private Sub TextBox1_Change()

Dim text As Variant
text = TextBox1.text: text = UCase(text): TextBox1.text = text
UCase (TextBox1.Value)
Call KayıtlarıAl

End Sub

Private Sub UserForm_Activate()

Call KayıtlarıAl

End Sub

Private Sub UserForm_Click()






End Sub
 



Forumumuzu reklamsız kullanmak, Hazır Excel Dosyaları indirmek ve web sitemize destek olmak için Hesap Yükseltme yapabilirsiniz. Detayları buradan inceleyebilir, hemen hesabınızı yükseltebilirsiniz.

Ömer BARAN

Kurucu
Yönetici
Kurucu
Versiyon
  1. Excel 2013
Sürüm
  1. 32 bit
Dil
  1. Türkçe

Reputation:

Foruma hoşgeldiniz Sayın @kutman kaplan .

Sorularınızı, cevabımın altındaki İMZA bölümünde yer alan açıklamalar (mutlaka okuyunuz)
doğrultusunda hazırlayacağınız örnek belge üzerinden sorarsanız daha hızlı çözüme ulaşmanız kolaylaşır.

Satır döngüsü kurulduğunda, veri yığını büyükse yavaşlama olabilir.
Elbette bu sorunu aşmak mümkün, kodların içerisinde olduğu ve bir miktar da veri olan bir örnek belge eklerseniz daha iyi olur.

.
 



Forumumuzu reklamsız kullanmak, Hazır Excel Dosyaları indirmek ve web sitemize destek olmak için Hesap Yükseltme yapabilirsiniz. Detayları buradan inceleyebilir, hemen hesabınızı yükseltebilirsiniz.

kutman kaplan

Yeni Üye
Kullanıcı
Yaş
30
Versiyon
  1. Excel 2010
Sürüm
  1. 64 bit
Dil
  1. Türkçe

Reputation:

Ömer bey eklemiştim galiba yüklememiş kusura bakmayın şimdi ekledim .
 



Forumumuzu reklamsız kullanmak, Hazır Excel Dosyaları indirmek ve web sitemize destek olmak için Hesap Yükseltme yapabilirsiniz. Detayları buradan inceleyebilir, hemen hesabınızı yükseltebilirsiniz.

Ekli dosyalar (Dosyaları İndirmek İçin Beğenmeniz Gerekir)

  • veri süzme.xlsm
    961.1 KB · Görüntüleme: 5

Ömer BARAN

Kurucu
Yönetici
Kurucu
Versiyon
  1. Excel 2013
Sürüm
  1. 32 bit
Dil
  1. Türkçe

Reputation:

Vakit çok geç oldu. sabahı ettik.
Halledemezseniz uygun zamanda ben veya başka bir arkadaşımız konuyla ilgilenecektir.

Şimdilik aşağıdaki konu sayfasında iki seçenekli bir çözüm var.
Bunlardan birini kendi dosyanıza uyarlamayı deneyin (sonuç alınamasa bile denemek faydalıdır).

Biri filtreleme (6 no'lu cevap), diğeri dizi yöntemidir (7 no'lu cevap).
Belgede VBA kısmı şifreliydi ve şifre konu sayfasında yazılı (gerekecektir).

 



Forumumuzu reklamsız kullanmak, Hazır Excel Dosyaları indirmek ve web sitemize destek olmak için Hesap Yükseltme yapabilirsiniz. Detayları buradan inceleyebilir, hemen hesabınızı yükseltebilirsiniz.

Çözüm

kutman kaplan

Yeni Üye
Kullanıcı
Yaş
30
Versiyon
  1. Excel 2010
Sürüm
  1. 64 bit
Dil
  1. Türkçe

Reputation:

Sayın hocam uyarlayamadım. Yardımcı olabilirmisiniz.
 



Forumumuzu reklamsız kullanmak, Hazır Excel Dosyaları indirmek ve web sitemize destek olmak için Hesap Yükseltme yapabilirsiniz. Detayları buradan inceleyebilir, hemen hesabınızı yükseltebilirsiniz.

Feyzullah

Feyzullah KILINÇ - XD Yönetim
Yönetici
Site Yöneticisi

Reputation:

C++:
Sub KayıtlarıAl()

Dim KayıtSayısı, Satır As Variant
ListBox1.Clear
KayıtSayısı = Sheets("Data").Cells(Rows.Count, "A").End(xlUp).Row
For Satır = 3 To KayıtSayısı
    If InStr(UCase(Sheets("Data").Range("a" & Satır)), TextBox1.Value) > 0 Then
       ListBox1.AddItem Sheets("Data").Range("a" & Satır)
    End If
Next Satır

End Sub


Private Sub Frame1_Click()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Private Sub ListBox1_Click()

ActiveCell.Value = ListBox1.Value

End Sub

Private Sub TextBox1_Change()

Dim text As Variant
text = TextBox1.text: text = UCase(text): TextBox1.text = text
UCase (TextBox1.Value)
Call KayıtlarıAl

End Sub

Private Sub UserForm_Activate()

Call KayıtlarıAl

End Sub

Private Sub UserForm_Click()






End Sub


Merhaba,

KayıtlarıAL kodunuzu aşağıdaki ile değiştirin

CSS:
Sub KayıtlarıAl()
t = Timer
ListBox1.Clear
Set con = CreateObject("adodb.connection")
Set rs = CreateObject("Adodb.Recordset")
con.Open "provider=microsoft.ace.oledb.12.0;data source=" _
& ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=NO"""
sorgu = "select f1 from [data$] "
If TextBox1.text <> "" Then sorgu = sorgu & " where [f1] like '%" & TextBox1.text & "%' "
rs.Open sorgu, con, 1, 1
If rs.RecordCount > 0 Then

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
ListBox1.Column = rs.getrows
ListBox1.ColumnCount = 1
End If
con.Close
Set con = Nothing
MsgBox Format(Timer - t, "Fixed") & "Sn."
End Sub
 



Forumumuzu reklamsız kullanmak, Hazır Excel Dosyaları indirmek ve web sitemize destek olmak için Hesap Yükseltme yapabilirsiniz. Detayları buradan inceleyebilir, hemen hesabınızı yükseltebilirsiniz.

kutman kaplan

Yeni Üye
Kullanıcı
Yaş
30
Versiyon
  1. Excel 2010
Sürüm
  1. 64 bit
Dil
  1. Türkçe

Reputation:

Teşekkür ederim öncekinden daha iyi
 



Forumumuzu reklamsız kullanmak, Hazır Excel Dosyaları indirmek ve web sitemize destek olmak için Hesap Yükseltme yapabilirsiniz. Detayları buradan inceleyebilir, hemen hesabınızı yükseltebilirsiniz.

Feyzullah

Feyzullah KILINÇ - XD Yönetim
Yönetici
Site Yöneticisi

Reputation:

Sn. @Ömer BARAN hocanın bahsettiği konuda ki 7.mesajda yazan kodların sizin dosyanıza göre uyarlanmış hali aşağıdadır.

CSS:
KayitlarıAl()
' Ömer BARAN
' www.ExcelDestek.Com
'
t = Timer
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim dizi()
On Error Resume Next
ListBox1.Clear
ListBox1.RowSource = ""
ListBox1.ColumnCount = 1
Set k = Sheets("Data")
If k.AutoFilterMode = True Then k.AutoFilterMode = False
kson = k.Cells(Rows.Count, 1).End(3).Row
If TextBox1 = "" Then
    ListBox1.RowSource = "Data!A2:A" & kson
Else
    k.Range("$A$1:$A$" & kson).AutoFilter Field:=1, Criteria1:="*" & Me.TextBox1 & "*"
    For Each h In k.Range("A2:A" & kson).SpecialCells(xlCellTypeVisible)
        say = say + 1: ReDim Preserve dizi(1 To 1, 0 To say)
        For s = 1 To 1: dizi(s, say - 1) = k.Cells(h.Row, s): Next
    Next
    Me.ListBox1.List = Application.Transpose(dizi)
    say = Empty: Erase dizi
    k.Range("$A$1:$A$" & kson).AutoFilter Field:=1
End If
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
MsgBox Format(Timer - t, "Fixed") & "Sn."
End Sub
 



Forumumuzu reklamsız kullanmak, Hazır Excel Dosyaları indirmek ve web sitemize destek olmak için Hesap Yükseltme yapabilirsiniz. Detayları buradan inceleyebilir, hemen hesabınızı yükseltebilirsiniz.

Üst