Listview penceresine kayıt aktarma ve veri süzme

krediborcumvar · 15 Mayıs 2011

Arkadaşlar hızlı arama yaparken harflerin indeksli bir şekilde sıralanması ve süzülen verilerin toplamının Texbox'da yer almasını sağlayan kodu yazarsanız memnun olacağım.

Ferhat Pazarçevirdi · 15 Mayıs 2011

Merhabalar,

Ekteki örnek dosyayı inceleyiniz.

Kodların tamamı, UserForm1 kod modülüne kopyalanmalı.

Not : Runtime esnasında görünmese de; UserForm'a, 1 adet "ImageList1" adında ImageList nesnesi eklenmelidir.

Kod:

Option Explicit

Dim booIni As Boolean

Private Sub ComboBox1_Change()
    Call Lvw_Guncelle
End Sub

Private Sub CommandButton1_Click()
    Unload Me
End Sub

Private Sub TextBox1_Change()
    Call Lvw_Guncelle
End Sub

Private Sub UserForm_Initialize()
    Dim i As Integer
    
    booIni = True
    
    With ComboBox1
        For i = 2 To 7
            .AddItem Cells(1, i)
        Next i
        .ListIndex = 0
        .Style = fmStyleDropDownList
    
    End With
    
    With ListView1
        .FullRowSelect = True
        .Gridlines = True
        .View = lvwReport
        .Icons = ImageList1
        .SmallIcons = ImageList1
        With .ColumnHeaders
            For i = 2 To 7
                .Add , , Cells(1, i), Cells(1, i).Width
            Next i
        End With
    End With
    
    TextBox1.SetFocus
    
    Me.Caption = "Ara/Bul - www.excel.web.tr"
    
    booIni = False
    
    Call Lvw_Guncelle
    
End Sub

Private Sub Lvw_Guncelle()
    Dim oItm As ListItem
    Dim rngBul As Range
    Dim sAdr As String
    Dim aramaKriteri As Long
    
    Dim i As Integer
    Dim lStr As Long
    
    If booIni Then Exit Sub
    
    If CheckBox1 Then
        aramaKriteri = xlWhole
    Else
        aramaKriteri = xlPart
    End If
    
    If Len(TextBox1) > 0 Then
        With ListView1
            .ListItems.Clear
            Set rngBul = Columns(ComboBox1.ListIndex + 2). _
                         Find(TextBox1, LOOKAT:=aramaKriteri)
            If Not rngBul Is Nothing Then
                sAdr = rngBul.Address
                Do
                    lStr = rngBul.Row
                    Set oItm = .ListItems.Add(, , Cells(lStr, 2), 1, 1)
                    With oItm.ListSubItems
                        .Add , , Cells(lStr, 3)
                        .Add , , Cells(lStr, 4)
                        .Add , , Cells(lStr, 5)
                        .Add , , Cells(lStr, 6)
                        .Add , , Cells(lStr, 7)
                    End With
                    
                    Set rngBul = Columns(ComboBox1.ListIndex + 2). _
                                 FindNext(rngBul)
                
                Loop Until rngBul Is Nothing Or sAdr = rngBul.Address
            End If
        End With
    Else
        With ListView1
            .ListItems.Clear
            For i = 2 To Cells(65536, 2).End(xlUp).Row
                Set oItm = .ListItems.Add(, , Cells(i, 2), 1, 1)
                With oItm.ListSubItems
                    .Add , , Cells(i, 3)
                    .Add , , Cells(i, 4)
                    .Add , , Cells(i, 5)
                    .Add , , Cells(i, 6)
                    .Add , , Cells(i, 7)
                End With
            Next i
        End With
    End If
    
    If ListView1.ListItems.Count > 0 Then
        Label7.Caption = "SONUÇ : Kriterinize uyan, " & _
                          ListView1.ListItems.Count & " adet '" & ComboBox1 & _
                          "' verisi bulunmuştur"
    Else
        Label7.Caption = "SONUÇ : Kriterinize uygun '" & _
                         ComboBox1 & "' verisi bulunamamıştır"
    End If
    
    Set rngBul = Nothing

End Sub

.

krediborcumvar · 15 Mayıs 2011

Ferhat Bey ilginize çok teşekkür ediyorum. Elinize gönlünüze sağlık, çok güzel olmuş. Ancak hızlı aramada sorun var. 'H' harfine bastığımda 'H' harfi ile başlayan isimlerin yanında diğer isimlerde filitrelemeye dahil oluyor. Bunu engelleyebilir miyiz?

Ferhat Pazarçevirdi · 15 Mayıs 2011

TextBox'a, "H" girdiğinizde, "H" ile başlayanlar değil, içeriğinde "H" olan tüm kayıtlar listelenir.

Örneğin "HA" yazdığınızda, hem HASAN'ın hem de PERİHAN'ın geldiğine dikkat edin.

Bunu istemiyor musunuz?

.

krediborcumvar · 15 Mayıs 2011

Ferhat Hocam sizi saygıyla selamlıyorum;
Ben içerisinde H harfi olan değil, Örneğin; "A" harfi ile başlayan bir kayıt arıyorsam, ilk harfi "Aa" olan kayıtları, ve ardından girdiğim her harfin karşılığı olan kayıtları geritmesini istiyorum.

Ferhat Bey, VBA ile ilgili kodların öğretimini veren tavsiye edeceğiniz bir kitap var mı?
Saygılar sunarım.

Ferhat Pazarçevirdi · 15 Mayıs 2011

Anladım.

Siz arama ile birlikte bir süzme işlemini de düşünüyorsunuz.

O zaman ekteki dosyayı inceleyiniz.

Şu satır,

Kod:

Set rngBul = Columns(ComboBox1.ListIndex + 2). _
             Find(TextBox1 , LOOKAT:=aramaKriteri)

Şu şekilde değiştirilmiştir.

Kod:

Set rngBul = Columns(ComboBox1.ListIndex + 2). _
             Find(TextBox1 [COLOR="Red"][B]& "*"[/B][/COLOR], LOOKAT:=aramaKriteri)

Ayrıca, Initialize esnasında, ChecjBox1'e True değeri atanmıştır. Siz de en alttaki Check'i hep tiklenmiş tutarsanız, istediğiniz işlem gerçekleşecektir.

Not : Kitabın iyisi kötüsü olmaz. Siz herhangi birinden başlayın. İllaki bir şeyler kaparsınız. Takıldığınız yerlerde, buraya sorun. Ezberden ziyade, işin mantığını kavramaya çalışın. Bu süreç, biraz uzun sürebilir aceleci olmayın.

.

krediborcumvar · 16 Mayıs 2011

Size sonsuz teşekkürlerimi sunuyorum. Saolun

cem yılmaz · 30 Aralık 2016

Merhabalar.
Bu çalışmayı kendi userform'uma ekledim ama kodlar aktif sayfada arama yapıyor. Peki şu sayfada arama yap kodunu nasıl ekleyebiliriz?

Private Sub Lvw_Guncelle()
Dim oItm As ListItem
Dim rngBul As Range
Dim sAdr As String
Dim aramaKriteri As Long

Dim i As Integer
Dim lStr As Long

If booIni Then Exit Sub

If CheckBox1 Then
aramaKriteri = xlWhole
Else
aramaKriteri = xlPart
End If

If Len(TextBox1) > 0 Then
With ListView1
.ListItems.Clear
Set rngBul = Columns(ComboBox1.ListIndex + 2).Find(TextBox1, LOOKAT:=aramaKriteri)
If Not rngBul Is Nothing Then
sAdr = rngBul.Address
Do
lStr = rngBul.Row
Set oItm = .ListItems.Add(, , Cells(lStr, 2), 1, 1)
With oItm.ListSubItems
.Add , , Cells(lStr, 3)
.Add , , Cells(lStr, 4)
.Add , , Cells(lStr, 5)
.Add , , Cells(lStr, 6)
.Add , , Cells(lStr, 7)
End With

Set rngBul = Columns(ComboBox1.ListIndex + 2).FindNext(rngBul)

Loop Until rngBul Is Nothing Or sAdr = rngBul.Address
End If
End With
Else
With ListView1
.ListItems.Clear
For i = 2 To Cells(65536, 2).End(xlUp).Row
Set oItm = .ListItems.Add(, , Cells(i, 2), 1, 1)
With oItm.ListSubItems
.Add , , Cells(i, 3)
.Add , , Cells(i, 4)
.Add , , Cells(i, 5)
.Add , , Cells(i, 6)
.Add , , Cells(i, 7)
End With
Next i
End With
End If

If ListView1.ListItems.Count > 0 Then
Label7.Caption = "SONUÇ : Kriterinize uyan, " & ListView1.ListItems.Count & " adet '" & ComboBox1 & "' verisi bulunmuştur"
Else
Label7.Caption = "SONUÇ : Kriterinize uygun '" & ComboBox1 & "' verisi bulunamamıştır"
End If

Set rngBul = Nothing

End Sub

PLİNT · 30 Aralık 2016

Merhaba
"Combobox2" ekleyip
"UserForm_Initialize" (zaten vardır) altına

Kod:

[SIZE="2"]Private Sub UserForm_Initialize()
For j = 1 To Sheets.Count
ComboBox2.AddItem Sheets(j).Name
Next
'......
'......diğer kodlar
End Sub[/SIZE]

yeni;

Kod:

[SIZE="2"]Private Sub ComboBox2_Change()
If ComboBox2.Value = "" Then Exit Sub
For a = 0 To ComboBox2.ListCount - 1
If ComboBox2.Value = ComboBox2.List(a) Then x = 1
Next
If x = empty Then ComboBox2.Value = "": MsgBox "SAYFA ADINI LİSTEDEN SEÇİNİZ"
End Sub [/SIZE]

Aşağıdaki gibi olabilir.

Kod:

[SIZE="2"]Private Sub Lvw_Guncelle()
Dim oItm As ListItem
Dim rngBul As Range
Dim sAdr As String
Dim aramaKriteri As Long
Dim i As Integer
Dim lStr As Long
'................................
[COLOR="Red"]Dim s1 As Worksheet
If ComboBox2.Value = "" Then
[COLOR="Blue"]Set s1 = ActiveSheet[/COLOR]
Else
Set s1 = Sheets(ComboBox2.Value)
End If[/COLOR]
'................................
If booIni Then Exit Sub
If CheckBox1 Then
aramaKriteri = xlWhole
Else
aramaKriteri = xlPart
End If

If Len(TextBox1) > 0 Then
With ListView1
.ListItems.Clear
Set rngBul = [COLOR="Red"]s1.[/COLOR]Columns(ComboBox1.ListIndex + 2).Find(TextBox1, LOOKAT:=aramaKriteri)
If Not rngBul Is Nothing Then
sAdr = rngBul.Address
Do
lStr = rngBul.Row
Set oItm = .ListItems.Add(, , [COLOR="Red"]s1.[/COLOR]Cells(lStr, 2), 1, 1)
With oItm.ListSubItems
.Add , , [COLOR="Red"]s1.[/COLOR]Cells(lStr, 3)
.Add , , [COLOR="Red"]s1.[/COLOR]Cells(lStr, 4)
.Add , , [COLOR="Red"]s1.[/COLOR]Cells(lStr, 5)
.Add , , [COLOR="Red"]s1.[/COLOR]Cells(lStr, 6)
.Add , , [COLOR="Red"]s1.[/COLOR]Cells(lStr, 7)
End With

Set rngBul = [COLOR="Red"]s1[/COLOR].Columns(ComboBox1.ListIndex + 2).FindNext(rngBul)
Loop Until rngBul Is Nothing Or sAdr = rngBul.Address
End If
End With
Else
With ListView1
.ListItems.Clear
For i = 2 To [COLOR="Red"]s1.[/COLOR]Cells(65536, 2).End(xlUp).Row
Set oItm = .ListItems.Add(, , [COLOR="Red"]s1.[/COLOR]Cells(i, 2), 1, 1)
With oItm.ListSubItems
.Add , , [COLOR="Red"]s1.[/COLOR]Cells(i, 3)
.Add , , [COLOR="Red"]s1.[/COLOR]Cells(i, 4)
.Add , , [COLOR="Red"]s1.[/COLOR]Cells(i, 5)
.Add , , [COLOR="Red"]s1[/COLOR].Cells(i, 6)
.Add , , [COLOR="Red"]s1[/COLOR].Cells(i, 7)
End With
Next i
End With
End If

If ListView1.ListItems.Count > 0 Then
Label7.Caption = "SONUÇ : Kriterinize uyan, " & ListView1.ListItems.Count & " adet '" & ComboBox1 & "' verisi bulunmuştur"
Else
Label7.Caption = "SONUÇ : Kriterinize uygun '" & ComboBox1 & "' verisi bulunamamıştır"
End If
Set rngBul = Nothing
End Sub[/SIZE]

cem yılmaz · 30 Aralık 2016

cevabınız için teşekkür ederim Sn PLİNT. Ama initialize açılırken hata veriyor. Nerede yanlış yapıyor olabilirim.?

Private Sub UserForm_Initialize()

Dim i As Integer

booIni = True

With ComboBox1
For i = 2 To 7
.AddItem Cells(1, i)
Next i
.ListIndex = 0
.Style = fmStyleDropDownList

End With

With ListView1
.FullRowSelect = True
.Gridlines = True
.View = lvwReport
.Icons = ImageList1
.SmallIcons = ImageList1
With .ColumnHeaders
For i = 2 To 7
.Add , , Cells(1, i), Cells(1, i).Width
Next i
End With
End With

TextBox1.SetFocus

Me.Caption = "Ara/Bul - www.excel.web.tr"

booIni = False

Call Lvw_Guncelle

For j = 1 To Sheets.Count
ComboBox2.AddItem Sheets(j).Name
Next
End Sub

PLİNT · 30 Aralık 2016

Eğer mümkünse yukarıdaki örnek dosyayı indiremiyorum;
http://s3.dosya.tc/ adresine yükleyip indirme adresini verirmisiniz.

"UserForm_Initialize" altında
"Call Lvw_Guncelle" bölümü varmış alta alalım

Kod:

Private Sub UserForm_Initialize()
'....
'.......
For j = 1 To Sheets.Count
ComboBox2.AddItem Sheets(j).Name
Next
Call Lvw_Guncelle
End Sub

"Exit sub" yerine aşağıdaki kırmızı bölümü
(Önceki mesajdaki değişen gibi)

Kod:

Private Sub Lvw_Guncelle()
'...
'......
 Dim s1 As Worksheet
If ComboBox2.Value = "" Then
[COLOR="Red"]Set s1 = ActiveSheet[/COLOR]
Else
Set s1 = Sheets(ComboBox2.Value)
End If
'....
'....

cem yılmaz · 30 Aralık 2016

linkteki dosyanın adresi
http://s3.dosya.tc/server10/jwk8cy/DENEME_1_.zip.html

benim çalışma sayfam ( forumdaki başka bir arkadaşın çalışmasıdır.Alıntıdır)
http://s3.dosya.tc/server10/36wdgm/Kopya_DEPO_SAYIM.xls.html

Teşekkürler.

PLİNT · 31 Aralık 2016

Merhaba
Formunu uygulamak istediğiniz dosya ile sizin dosyadaki sayfalar tam olarak uyumlu değil.
Sizin dosyanıza göre uyarlamaya çalıştım; ek dosyayı deneyelim.
http://s3.dosya.tc/server10/8x0vqd/Kopya_DEPO_SAYIM.zip.html
"Arama formu" kod sayfası:

Kod:

[SIZE="2"]Private Sub CommandButton1_Click()
    Unload Me
End Sub

Private Sub ComboBox2_Change()
If ComboBox2.Value = "" Then Exit Sub
For a = 0 To ComboBox2.ListCount - 1
If ComboBox2.Value = ComboBox2.List(a) Then x = 1
Next
If x = Empty Then ComboBox2.Value = "": MsgBox "SAYFA ADINI LİSTEDEN SEÇİNİZ": Exit Sub
ComboBox1.Clear
Call UserForm_Initialize
End Sub

Private Sub TextBox1_Change()
Dim oItm As ListItem
Dim rngBul As Range
Dim sAdr As String
Dim aramaKriteri As Long
Dim i As Integer
Dim lStr As Long
'................................
Dim sf As Worksheet

If ComboBox2.Value = "" Then
Set sf = ActiveSheet
Else
Set sf = Sheets(ComboBox2.Value)
End If


If CheckBox1.Value = True Then
aramaKriteri = xlWhole
Else
aramaKriteri = xlPart
End If

If Len(TextBox1) > 0 Then
If ComboBox1.Value = "" Then MsgBox "KRİTER SEÇİNİZ": TextBox1 = "": Exit Sub
With ListView1
.ListItems.Clear
Set rngBul = sf.Columns(ComboBox1.ListIndex + 1).Find(TextBox1.Text, LookIn:=xlValues, LOOKAT:=aramaKriteri)
If Not rngBul Is Nothing Then

sAdr = rngBul.Address
Do
lStr = rngBul.Row
'If LCase(rngBul) Like LCase("*" & TextBox1.Text & "*") Then
ListView1.ListItems.Add , , sf.Cells(lStr, 1).Value
y = .ListItems.Count
For a = 2 To 7
.ListItems(y).ListSubItems.Add , , sf.Cells(lStr, a).Value
Next
'End If:
Set rngBul = sf.Columns(ComboBox1.ListIndex + 1).FindNext(rngBul)
Loop Until rngBul Is Nothing Or sAdr = rngBul.Address
End If:
End With
Else
Call UserForm_Initialize
End If
If ListView1.ListItems.Count > 0 Then
If Trim(ListView1.ColumnHeaders(1).Text) = Trim(ListView1.ListItems(1).Text) Then ListView1.ListItems.Remove (1)

Label7.Caption = "SONUÇ : Kriterinize uyan, " & ListView1.ListItems.Count & " adet '" & ComboBox1 & "' verisi bulunmuştur"
Else
Label7.Caption = "SONUÇ : Kriterinize uygun '" & ComboBox1 & "' verisi bulunamamıştır"
End If
Set rngBul = Nothing
End Sub

Private Sub UserForm_Initialize()
Dim j, i As Integer
Dim f, n, y
Dim sf As Worksheet
If ComboBox2.Value <> "" Then
Set sf = Sheets(ComboBox2.Value)
Else
Set sf = ActiveSheet
End If
ListView1.ListItems.Clear: ListView1.ColumnHeaders.Clear
With ListView1
.View = lvwReport: .Gridlines = True: .FullRowSelect = True: .ListItems.Clear
For sat = 1 To 10
If sf.Cells(sat, 2) <> "" Then Exit For
Next
For a = 1 To 7
f = (sf.Columns(a).ColumnWidth - ((sf.Columns(a).ColumnWidth / 10) * 1.5)) * 8 '4.43
.ColumnHeaders.Add , , sf.Cells(sat, a) & " ", f
Next
End With
ComboBox1.Clear
With ComboBox1
For i = 1 To 7
.AddItem sf.Cells(sat, i)
Next i
.ListIndex = 0
.Style = fmStyleDropDownList
End With
n = 1
If sf.Cells(Rows.Count, 1).End(3).Row < 2 Then n = 2

For i = sat + 1 To sf.Cells(Rows.Count, n).End(xlUp).Row
ListView1.ListItems.Add , , sf.Cells(i, 1).Value
y = ListView1.ListItems.Count
For a = 2 To 7
ListView1.ListItems(y).ListSubItems.Add , , sf.Cells(i, a).Value
Next
Next i
TextBox1 = ""
    TextBox1.SetFocus
    Me.Caption = "Ara/Bul - www.excel.web.tr"
If ComboBox2.ListCount > 0 Then Exit Sub
    ComboBox2.Clear
For j = 1 To Sheets.Count
ComboBox2.AddItem Sheets(j).Name
Next
End Sub[/SIZE]

cem yılmaz · 1 Ocak 2017

Yardımlarınız için teşekkür ederim sağolun.

PLİNT · 1 Ocak 2017

cem yılmaz' Alıntı:
Yardımlarınız için teşekkür ederim sağolun.

Rica ederim,
sizde sağolun, kolay gelsin.

Listview penceresine kayıt aktarma ve veri süzme

krediborcumvar

Ekli dosyalar

Ferhat Pazarçevirdi

Özel Üye

Ekli dosyalar

krediborcumvar

Ferhat Pazarçevirdi

Özel Üye

krediborcumvar

Ferhat Pazarçevirdi

Özel Üye

Ekli dosyalar

krediborcumvar

cem yılmaz

PLİNT

cem yılmaz

PLİNT

cem yılmaz

PLİNT

cem yılmaz

PLİNT