Çok boyutlu dizide filtreleme yapma

[merakli_72]

Günaydın arkadaşlar,
Dizide filtreleme yapma ile ilgili sadece Filtre komutunu bulabildim ama oda anladığım kadarıyla tek boyutlu dizilerde çalışıyor, iki boyutlu dizilerde filtreleme ile ilgli hazır bir komut varmı.

Bir döngü ve if komutu ilede elbette filtreleme teknikleri geliştirilebiliyor ama dizinin eleman sayısı 27.610 (artmaya devam ediyor) ve bu iş döngü ile yapıldığında uzun sürüyor. Önerileriniz ne olabilir

Teşekkürler

 

[Ferhat Pazarçevirdi]

Merhabalar,

İlkönce, -merakımı mazur görün- boyutu her ne olursa olsun, bir diziyi, filtre edecek komutu VBA'da nereden bulduğunuzu öğrenmek isterim ...

Dizi, değil ama bir Collection nesnesinde, göreceli olarak süzme (seçme) yapabilirsiniz. Bu nesne de; tek boyutlu bir dizi gibi davranır.

Benim önerim; bu tür büyük datalar üzerinde işlem yapabilmek için Recordset (Activex DataObject Recordset) nesnesi kullanmanızdır. İstediğiniz şekilde; filtreleme, sıralama gibi işlemleri tek bir komutla halledebilirsiniz.


.

 

[merakli_72]

mrb, aşağıdaki açıklamadan ben oyle bir sonuç çıkardım
Ek kontrollerde Activex DataObject Recordset isimli bir kontrol bulamadım
bu kontrole nasıl ulaşılabilir ve kullanımıyla ilgili bir örnek dosya varmı acaba elinizde



Filter Function

Description

Returns a zero-based array containing subset of a string array based on a specified filter criteria.

Syntax

Filter(sourcesrray, match[, include[, compare]])

The Filter function syntax has these named argument:

Part Description
sourcearray Required. One-dimensional array of strings to be searched.
match Required. String to search for.
include Optional. Boolean value indicating whether to return substrings that include or exclude match. If include is True, Filter returns the subset of the array that contains match as a substring. If include is False, Filter returns the subset of the array that does not contain match as a substring.
compare Optional. Numeric value indicating the kind of string comparison to use. See Settings section for values.



Settings

The compare argument can have the following values:

 

[Ferhat Pazarçevirdi]

Ben bu işlevi hiç görmemiş ve kullanmamıştım. Haklısınız, dizi filtreleme için Filter komutu çok işe yarıyor...

Ancak, tek boyutlu dizilerle sınırlı tabi ...

Siz, orjinal dosyanızdakine benzer datalar içeren bir örnek dosya yerleştirin ben de Recordset kullanımını size örnekleyeyim.

Filter işlevi için de ayrıca teşekkürler ...:bravo:


.

 

[merakli_72]

Ferhat bey tekrar mrb,
Ekteki tabloda ürün listemiz var;
A sutununda ürün kodları B sutununda ise ürün isimleri mevcut
Kullanıcı kodlardan anlamayacağı için isim üzerinden seçim yaptırıyorum, fakat databaseden veri çekmek içinde bana ürün kodları lazım oluyor

Bu yüzden 2 boyutlu bir dizi üzerinde filtreleme peşindeyim, kullanıcının form üzerinde listboxtan seçtiği isimlerin kodlarınada ulaşabilmeliyim, bildiğim yöntemlerle bu iş oluyor ama biraz yavaş kalıyor. Listboxta ismin bir yerine koduda yazdırırsak bu seferde biçimsiz duruyor.
Umarım ne yapmak istediğimi anlatabilmişimidir.
Teşekkürler

 

[Ferhat Pazarçevirdi]

Ekteği örneği inceleyiniz.

Burada, bazı süzme (filtre) seçeneklerini yerleştirdim. Umarım hızı yeterli gelir.

İyi çalışmalar.


.

 

[Orion1]

Alternatif.
Dizi yönetimi ile verileri alıyorsunuz.
27.600 satır 2 sn yede işi bitiyor.
Arama yöntemi (ile başlar) şeklinde yapılıyor.
Dosyanız eketdir.

Option Base 1
Private Sub CommandButton1_Click()
Dim sat As Long, i As Long, a As Long, isim As String, list(), ad As String
ListBox1.Clear
sat = Sheets("Sayfa1").Cells(65536, "B").End(xlUp).Row
ReDim myarr(1 To 2, 1 To sat)
list = Range("A2:B" & sat).Value
isim = UCase(Replace(Replace(TextBox1.Text, "ı", "I"), "i", "İ")) & "*"
For i = 1 To UBound(list)
    ad = UCase(Replace(Replace(list(i, 2), "ı", "I"), "i", "İ"))
    If ad Like isim Then
        a = a + 1
        myarr(1, a) = list(i, 1)
        myarr(2, a) = list(i, 2)
    End If
Next i
Erase list
If a > 0 Then
    ReDim Preserve myarr(1 To 2, 1 To a)
    ListBox1.Column = myarr
End If
Erase myarr
End Sub

Private Sub ListBox1_Click()
If ListBox1.ListCount > 0 Then TextBox2.Text = ListBox1.Column(0)
End Sub

Private Sub UserForm_Initialize()
Dim sat As Long
ListBox1.ColumnCount = 2
ListBox1.ColumnWidths = "0;200"
sat = Sheets("Sayfa1").Cells(65536, "B").End(xlUp).Row
ListBox1.list = Sheets("Sayfa1").Range("A2:B" & sat).Value
TextBox1.SetFocus
End Sub

 

[merakli_72]

Sayın Ferhat Bey,
öncelikle bize zaman ayırıp emeğinizi paylaştığınız için çok teşekkür ederim,
eğer izniniz olursa daha iyiyi bulma adına birkaç sorum olacaktı

1.
For Each rngHcr In rngLst.Cells
.AddNew
.Fields("Kodu").Value = rngHcr.Value
.Fields("Aciklama").Value = rngHcr.Offset(0, 1).Value
Next
Yukarıda sayfa üzerindeki verileri satır satır recordset nesnesine alıyoruz, recordset nesnesine bunları select * from ... şeklinde bir sorgu ile atıyamazmıyız eğer boyle birşey olursa daha hızlı vede pratik olurdu diye düşünüyorum

2.
rs.Filter = sKTip & " LIKE '" & sParam1 & .TextBox2 & sParam2 & "'"
End If

With .ListView1
.ListItems.Clear
If rs.RecordCount > 0 Then
rs.MoveFirst
Do Until rs.EOF
With .ListItems.Add
.Text = Trim(rs(0))
.SubItems(1) = Trim(rs(1))
End With
rs.MoveNext
Loop

Recordset nesnesinde filtreleme yaptıktan sonra bu sefer şartı sağlayan kayıtları tek tek listview nesnesine alıyoruz, listview nesnesini pek bilmiyorum ama mesela listboxta rowsourse,list gibi ozellikler var, gerekirse listbox kullanılsaydı recordset ile filtreleme yapılan kayıtlar direk listbox/listview aktarılabilirmiydi.

Teşekkür ederim

 

[merakli_72]

Sayın Evren Bey,

ListBox1.list = Sheets("Sayfa1").Range("A2:B" & sat).Value
harika bir kullanım, bunu bilmiyordum

bu yüzden sayfa üzerindeki verileri bir döngü ile önce satır satır bir diziye alıyor
sonrada ListBox1.list = dizi ile listboxa atıyordum buda zaman kaybı oluyordu,

Sizin örnekte hissedilmiyor fakat daha pratik olması için Ferhat Beyinki gibi bir işlem yapılıp texboxta bir harfe basılıp listbox üzerinde otomatik filtreleme yapıldığında sürekli kullanımda yavaşlık hissediliyor;

Ben mesela şöyle yaptım, veriler sayfa üzerinde kesinlikle sıralı bundan eminiz
textboxta B harfinemi basıldı
.find(B*) ile B harfi ile başlayan ilk satırı bulduruyorum
if .. ile kontrol ettirip textboxtakinden farkli bir harfe gelindiğinde exit.. ile döngüden çıkartıyorum

Yani sayfada listenin başından başlamayıp sonuna kadar gitmediği halde bastığınız harften başlayan ürün çoksa biraz bekletiyor (Tek kullanımda önemi değil ama bu işlem sürekli yapılıyor)

Şartı sağlayan kayıtlar bir döngü içinde alınmak yerine Select ... şeklinde bir sorgu ile falan listbox nesnesine alınamazmı (Alınacak veriler kesinlikle 2 sutundan oluşacak)

 

[Orion1]

Sıralı ise durum değşir tabbi.
Aşağıdaki kodları deneyiniz.
Örnek dosyanız ektedir.

Option Base 1
Private Sub CommandButton1_Click()
End Sub

Private Sub ListBox1_Click()
If ListBox1.ListCount > 0 Then TextBox2.Text = ListBox1.Column(0)
End Sub

Private Sub TextBox1_Change()
Dim sat As Long, k As Long, say As Long
ListBox1.Clear
sat = Sheets("Sayfa1").Cells(65536, "B").End(xlUp).Row
On Error Resume Next
k = WorksheetFunction.Match(TextBox1.Text & "*", Sheets("Sayfa1").Range("B1:B" & sat), 0)
If Err Then Exit Sub
say = WorksheetFunction.CountIf(Sheets("Sayfa1").Range("B" & k & ":B65536"), TextBox1.Text & "*") - 1
ListBox1.list = Sheets("Sayfa1").Range("A" & k & ":B" & k + say).Value
TextBox1.SetFocus
End Sub

Private Sub UserForm_Initialize()
Dim sat As Long
ListBox1.ColumnCount = 2
ListBox1.ColumnWidths = "0;200"
sat = Sheets("Sayfa1").Cells(65536, "B").End(xlUp).Row
ListBox1.list = Sheets("Sayfa1").Range("A2:B" & sat).Value
TextBox1.SetFocus
End Sub

Sayın Evren Bey,

ListBox1.list = Sheets("Sayfa1").Range("A2:B" & sat).Value
harika bir kullanım, bunu bilmiyordum

bu yüzden sayfa üzerindeki verileri bir döngü ile önce satır satır bir diziye alıyor
sonrada ListBox1.list = dizi ile listboxa atıyordum buda zaman kaybı oluyordu,

Sizin örnekte hissedilmiyor fakat daha pratik olması için Ferhat Beyinki gibi bir işlem yapılıp texboxta bir harfe basılıp listbox üzerinde otomatik filtreleme yapıldığında sürekli kullanımda yavaşlık hissediliyor;

Ben mesela şöyle yaptım, veriler sayfa üzerinde kesinlikle sıralı bundan eminiz
textboxta B harfinemi basıldı
.find(B*) ile B harfi ile başlayan ilk satırı bulduruyorum
if .. ile kontrol ettirip textboxtakinden farkli bir harfe gelindiğinde exit.. ile döngüden çıkartıyorum

Yani sayfada listenin başından başlamayıp sonuna kadar gitmediği halde bastığınız harften başlayan ürün çoksa biraz bekletiyor (Tek kullanımda önemi değil ama bu işlem sürekli yapılıyor)

Şartı sağlayan kayıtlar bir döngü içinde alınmak yerine Select ... şeklinde bir sorgu ile falan listbox nesnesine alınamazmı (Alınacak veriler kesinlikle 2 sutundan oluşacak)

 

[merakli_72]

Teşekkür ederim Evren Bey,
bu yöntem benim aklıma gelmemişti

 

[Orion1]

Teşekkür ederim Evren Bey,
bu yöntem benim aklıma gelmemişti

Rica ederim.
İyi çalışmalar.