Listbox ve Listview' da combobox ile süzme

cems · 10 Mart 2017

http://s3.dosya.tc/server11/shc9bz/listbox___listview__combobox_ile__suz.rar.html

15000 satırlık bir veride , birden fazla zamanda firma ile kontak kurulduğu için A sütununda bazı firmalar adı aynı olarak birden fazla bulunuyor. Eğer liste harf sırasında değilse bir yeni kontak ile ilgili satır listenin herhangi bir yerinde olabiliyor.

Ekte asıl dosya ile birebir aynı ama 50 satırlık bir örnek ve vba kısmında 1 listbox ile 1 listview örneği var .

Her iki yol ile veriyi süzerek tekrar eden satırları sağlıklı olarak getirmek gerek .

a) her iki userform açıldığında ikisinde de tam liste kutulara gelmeli
b) her ikisinde de combobox tan bir firma seçildiğinde ve ara tuşuna basınca altta süzerek o firmaya ait bütün satırlar gelmeli
c)her ikisinde de column baslıkları sabit ve görünür kalmalı . Çalıştıramadığım listview kodları içindeki başlıklar ve uzunlukları doğru olandır

İkisi için de destek istememin sebebi , ana dosyada biri ya da diğeri ama verimli görüneni kullanmak zira , yaptığım başarılı denemeleri anadosyaya kopyalayınca ya bir yerde hatayı görmüyorum ya da anlayamadığım bir çakışma oluyor.

vardar07 · 10 Mart 2017

UserForm5 e Kırmızılı kodu ekleyip diğerini değiştirip deneyiniz.

Kod:

[COLOR="Red"]Private Sub UserForm_Initialize()
With Sheets("Sayfa1")
For i = 2 To .Cells(Rows.Count, 1).End(3).Row
If WorksheetFunction.CountIf(.Range("A1:A" & i), .Cells(i, "A").Value) = 1 Then
        ComboBox1.AddItem .Cells(i, "A").Value
    End If
    Next
End With[/COLOR]


Private Sub CommandButton1_Click()
Dim X As Integer
   ' Dim Liste As ListItem
 If ComboBox1 = "" Then
 deg = "*"
 Else
deg = ComboBox1
End If
    With ListView1
'.ColumnHeaders.Clear
.View = lvwReport
.ColumnHeaders.Add , , "Company", 140
.ColumnHeaders.Add , , "Effect date", 60
.ColumnHeaders.Add , , "Ultimate", 50
.ColumnHeaders.Add , , "Contact_Name", 70
.ColumnHeaders.Add , , "GFIS_CID", 70
.ColumnHeaders.Add , , "DUNS_Nmuber", 70
.ColumnHeaders.Add , , "Client_Status", 70

.FullRowSelect = True
.Gridlines = True
End With
        ListView1.ListItems.Clear
        With Sheets("sayfa1")
           For i = 2 To .[A65536].End(3).Row
              If deg = Cells(i, "A") Then
              Set Liste = ListView1.ListItems.Add(, , .Cells(i, 1).Value)
                
                    Liste.SubItems(1) = .Cells(i, 15).Value
                    Liste.SubItems(2) = .Cells(i, 4).Value
                    Liste.SubItems(3) = .Cells(i, 10).Value
                    Liste.SubItems(4) = .Cells(i, 13).Value
                    Liste.SubItems(5) = .Cells(i, 5).Value
                    Liste.SubItems(6) = .Cells(i, 14).Value
                    'Liste.SubItems(7) = .Cells(i, 6).Value
             End If
            Next i
        End With
    Set Liste = Nothing
End Sub

cems · 10 Mart 2017

vardar07' Alıntı:

UserForm5 e Kırmızılı kodu ekleyip diğerini değiştirip deneyiniz.

Kod:

[COLOR="Red"]Private Sub UserForm_Initialize()
With Sheets("Sayfa1")
For i = 2 To .Cells(Rows.Count, 1).End(3).Row
If WorksheetFunction.CountIf(.Range("A1:A" & i), .Cells(i, "A").Value) = 1 Then
        ComboBox1.AddItem .Cells(i, "A").Value
    End If
    Next
End With
End sub [/COLOR]

[/QUOTE]

Bu kısımda " Runtime error 70 permission denied " olarak hata verdi , dolayısı ile sonraki kodun yürümesini görme şansı olmadı

vardar07 · 10 Mart 2017

Kod penceresinde iken F8 ile adım adım ilerleyip hata veren satır nedir görebilirsiniz. Ayrıca Private Sub UserForm_Initialize() yazan ikinci bir yer varsa silin yada içindeki verileri birleştirin.

cems · 10 Mart 2017

Bildiğimden değil ancak listview işlevi konusunda " BELKİ" reference ayarları ben ve başka bilgisayarda özel ayar gerektiriyor. Bu da özel olarak bütün yüklenecek bilgisayarda ayar demektir ki gerek yok .

Listbox da iş görür , yeter ki ;

userform açıldığında bütün liste listboxa gelsin
combobox ta bir firma seçildiğinde (bu arada firma listesini kendi rowsource ayarından alıyor ) ve tuşa basıldığında
aynı olan firmaları sıralasın ve diğerlerini kaldırsın

vardar07 · 10 Mart 2017

Ona bakarsanız listbox'ta da başlıklar çıkmaz ilk açılışta rowsource ile alınca çıkar süzme işleminde çıkmaz. Ayrıca Listview'de hiç bir referans ayarı yaptığımı hatırlamıyorum. Size verdiğim kod sizin dosyanızda denenip verilmiştir.

Orion1 · 10 Mart 2017

cems' Alıntı:
Bildiğimden değil ancak listview işlevi konusunda " BELKİ" reference ayarları ben ve başka bilgisayarda özel ayar gerektiriyor. Bu da özel olarak bütün yüklenecek bilgisayarda ayar demektir ki gerek yok .

Listbox da iş görür , yeter ki ;

userform açıldığında bütün liste listboxa gelsin
combobox ta bir firma seçildiğinde (bu arada firma listesini kendi rowsource ayarından alıyor ) ve tuşa basıldığında
aynı olan firmaları sıralasın ve diğerlerini kaldırsın

Dosya Linktedir.

DOSYAYI İNDİR
..

cems · 10 Mart 2017

Orion1' Alıntı:
Dosya Linktedir.

..

Sayın Orion ;
Dosya mükemmel şekilde anadosyamda da çalıştı , elinize sağlık

Tek bir şeyi atlamışım ya da bu soruda eklemeyi unuttum ; listbox başlık , veri aldığı sütunlar ve sütun uzunluklarını çalışana özet görünüm verdirmek üzere

.ColumnHeaders.Add , , "Company ", 145
.ColumnHeaders.Add , , "Effect date ", 60
.ColumnHeaders.Add , , "Ultimate ", 50 '
.ColumnHeaders.Add , , "Contact_Name", 70 '
.ColumnHeaders.Add , , "GFIS_CID", 70 '
.ColumnHeaders.Add , , "DUNS_Nmuber", 70
.ColumnHeaders.Add , , "Client_Status", 70

Şeklinde ayarlamak gerek . Can'ım kodlara ben bütün gün üğraşıp yapamadıktan sonra bunlara dokunmaya ve bozmaya kıyamıyorum , ancak sizden bu baslıklar ve verilerini süzmekte son bir dokunuş daha istirham edeceğim .

Sayın Vardar ;
Mutlaka ki dosyada deneyerek sayfaya yüklediniz , sizde ya da kodlar veya dosyada sorun yok . Sorun benim bu bilgi dağarcığını anadosyama nasıl ekleyeceğim konusunda yetersizliğimdi , teşekkür ederim .

Orion1 · 10 Mart 2017

1-Aşağıdaki kırmızı boyadığım satırda istediğiniz genişlikleri yazınız.
2-Kolon başlıklarını süz sayfasından 1nci satırından alıyor.

Kod:

Private Sub UserForm_Initialize()
Dim z As Object, liste()
If Sheets("Sayfa1").AutoFilterMode Then Sheets("Sayfa1").AutoFilterMode = False
Set z = CreateObject("Scripting.dictionary")
liste = Sheets("Sayfa1").Range("A2:A" & Sheets("Sayfa1").Cells(Rows.Count, "A").End(xlUp).Row).Value
For i = 1 To UBound(liste)
    If Not z.exists(liste(i, 1)) Then
        z.Add liste(i, 1), Nothing
    End If
Next i
If z.Count > 0 Then
    ComboBox1.List = Application.Transpose(Array(z.keys))
    ComboBox1.ListIndex = 0
End If
ListBox1.ColumnCount = 5
[B][COLOR="Red"]ListBox1.ColumnWidths = "80;120;80;80;120"[/COLOR][/B]
ListBox1.RowSource = "Sayfa1!A2:E" & Sheets("SAYFA1").Range("A65536").End(xlUp).Row
End Sub

cems · 10 Mart 2017

Orion1' Alıntı:

1-Aşağıdaki kırmızı boyadığım satırda istediğiniz genişlikleri yazınız.
2-Kolon başlıklarını süz sayfasından 1nci satırından alıyor.

Kod:

Private Sub CommandButton1_Click()
Dim s1 As Worksheet, s2 As Worksheet, sonsat2 As Long
ListBox1.RowSource = Empty
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Suz")
s2.Cells.Clear
If s1.AutoFilterMode Then s1.AutoFilterMode = False
s1.Range("A1").AutoFilter field:=1, Criteria1:=ComboBox1.Value & "*"
s1.Range("A1").CurrentRegion.Copy s2.Range("A1")
s1.AutoFilterMode = False
sonsat2 = s2.Cells(Rows.Count, "A").End(xlUp).Row
ListBox1.RowSource = "Suz!A2:m" & sonsat2

Sheets("suz").Select

    Selection.Delete Shift:=xlToLeft
    Columns("F:F").Select
    Selection.Delete Shift:=xlToLeft
    Columns("G:G").Select
    Selection.Delete Shift:=xlToLeft
    Columns("I:I").Select
    Selection.Delete Shift:=xlToLeft
    Columns("B:B").Select
    Selection.Delete Shift:=xlToLeft
    Columns("e:e").Select
    Selection.Delete Shift:=xlToLeft
End Sub

Sayın Orion1 ,

Kodlarınıza ek olarak , süz sayfasında gereksiz kolonları aktarmadan sonra silerek listbox a gerekli olanların
yansımasını sağlayarak sanıyorum sonuçlandırabildim .

Desteğiniz için çok teşekkür ederim

Orion1 · 11 Mart 2017

Dosyanız linktedir.

DOSYAYI İNDİR

..

cems · 11 Mart 2017

Orion1' Alıntı:
Dosyanız linktedir.

..

Sayın Gizlen ,

Dosyayı sabah farkettim , ana dosyaya ekledim ve şiir gibi çalıştı

Benim çözümüm olan sütun silerek kaydırma da olsa bile , silerken ekranı zıplatma gibi bir tuhaflığa da sebep olmuştu.

Sayın Ömer
Sayın Vardar07
Sayın Evren Gizlen

Sizlerin desteği ile çalışanlarımız için oldukça kullanışlı ve birkaç günlük işi birkaç dakikaya indiren bir anadosya oluştu . Sizlere keşke satırlarda sonsuz teşekkür dışında yapabileceğim bir şeyler olsaydı , Sayın Ömer'e de dediğim gibi sıcak demli bir bardak çay
bile ikram edemesem de , kuru teşekkürlerimi kabul etmenizi dilerim

Ellerinize sağlık

Ömer BARAN · 11 Mart 2017

Merhaba.

Esasa müessir birşey değil ama; Sayın GİZLEN'in verdiği çözümde kullanılan listele adlı makroda
aşağıdaki kırmızı satırların arasına mavi olanı eklemenizde yarar var sanırım.

Çünkü Combobox ile yaptığınız her listeleme işleminde Suz adlı sayfada, Sayfa1'deki düğmenin bir kopyası eklenmiş oluyor.
.

Kod:

[COLOR="Red"]s1.Range("A1").CurrentRegion.Copy s2.Range("A1")[/COLOR]
[COLOR="Blue"]s2.DrawingObjects.Delete[/COLOR]
[COLOR="Red"]s1.AutoFilterMode = False[/COLOR]

cems · 11 Mart 2017

Ömer BARAN' Alıntı:
Merhaba.

Esasa müessir birşey değil ama; Sayın GİZLEN'in verdiği çözümde kullanılan listele adlı makroda
aşağıdaki kırmızı satırların arasına mavi olanı eklemenizde yarar var sanırım.

Çünkü Combobox ile yaptığınız her listeleme işleminde Suz adlı sayfada, Sayfa1'deki düğmenin bir kopyası eklenmiş oluyor.
.

Kod:

[COLOR="Red"]s1.Range("A1").CurrentRegion.Copy s2.Range("A1")[/COLOR] [COLOR="Blue"]s2.DrawingObjects.Delete[/COLOR] [COLOR="Red"]s1.AutoFilterMode = False[/COLOR]

Sayın Ömer BARAN ,

Tavsiyeniz üzere ; verdiğiniz mavi renkteki satırı diğer kodlar arasına ekledim, anladığım kadarı ile "süz"e geçen ve kalan object olarak düğme her seferinde bu kod ile yenisi yerleşmeden önce silinecek.
Çalışma esnasındaki etkisi her süzmede birikimi önleme ve bir çeşit temizlik ; doğru çıkarım yapıyorsam .

En iyi için bilmeyeceğimiz noktalarda bilgilerinizle verdiğiniz ek katkıdan dolayı çok teşekkür ederim

Excel.web.tr bu yüzden saygın ve mutlu bir aile ocağı gibi

....Allahın rızası her daim üstünüzde olsun

Ömer BARAN · 11 Mart 2017

Estağfurullah. Asıl teşekkür Sayın GİZLEN'e.
Kolay gelsin.
.

Orion1 · 11 Mart 2017

Bende butonu kopyalamamıştı.onun için öylece bıraktım.
Şimdi tekrar baktığımda kopyalamış.
Butonu hiç kopyalamadan çözümü yaptım.
Dosyayı 11nci mesajdan indirebilirsiniz.

cems · 11 Mart 2017

Orion1' Alıntı:
Bende butonu kopyalamamıştı.onun için öylece bıraktım.
Şimdi tekrar baktığımda kopyalamış.
Butonu hiç kopyalamadan çözümü yaptım.
Dosyayı 11nci mesajdan indirebilirsiniz.

Şiirler peşpeşe

Bana kalan ise , onları okumak sadece , dizelerin ustalıklarına hayran olmak

Tekrar ince elemeniz için Teşekkür ederim Orion1

Orion1 · 11 Mart 2017

cems' Alıntı:
Şiirler peşpeşe

Bana kalan ise , onları okumak sadece , dizelerin ustalıklarına hayran olmak

Tekrar ince elemeniz için Teşekkür ederim Orion1

Rica ederim.
İyi çalışmalar.

Listbox ve Listview' da combobox ile süzme

cems

vardar07

Destek Ekibi

cems

vardar07

Destek Ekibi

cems

vardar07

Destek Ekibi

Orion1

Uzman

cems

Orion1

Uzman

cems

Orion1

Uzman

cems

Ömer BARAN

Uzman

cems

Ömer BARAN

Uzman

Orion1

Uzman

cems

Orion1

Uzman