[Yardım]  ComboBox Süzme sorunu

Açılır liste kutusu.

ComboBox Süzme sorunu

İleti#1)  kanakan52 » 30 Nis 2018 19:04

Arkadaşlar merhaba,
Ekteki çalışmamada Combobox2, Combobox4 te tekrarlayanları hallettim. Ama ne yaptıysam Combobox3 te tekrarlayanları getirmemeyi başaramadım.

Tam olarak istediğim Combobox3 e DATA2 sayfasında C sütunundaki verileri benzersiz olarak almak. Lütfen yardım rica ediyorum.
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
kanakan52
Siteye Alışmış
 
Adı Soyadı:Ümit AKBULUT
Kayıt: 15 May 2013 17:56
Konum: TÜRKİYE
Meslek: muhasebe
Yaş: 35
İleti: 344
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: ORDU

Cevap: ComboBox Süzme sorunu

İleti#2)  Orion1 » 30 Nis 2018 21:24

VBA Şifreli dosyanıza yanıt beklemeyin. :cool:
Kullanıcı avatarı
Orion1
Siteye Alışmış
 
Adı Soyadı:Evren Gizlen
Kayıt: 18 Tem 2008 22:51
Meslek: inşaat teknikeri
İleti: 386
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Türkiye

Cevap: ComboBox Süzme sorunu

İleti#3)  feraz » 30 Nis 2018 23:30

Merhaba pasif yaptığınız kodu aktif yapınca normalde çalışıyor.
CreateObject("Scripting.Dictionary") ekledim combo3 için.
Birde alttaki gibi deneyin.

Kod: Tümünü seç
Private Sub userform_Initialize()

Dim combo3 As Object
Set combo3 = CreateObject("Scripting.Dictionary")

Application.ScreenUpdating = True
For i = 2 To Sayfa1.[A65536].End(3).Row
'If WorksheetFunction.CountIf(Sayfa4.Range("AQ2:AQ" & i), Sayfa4.Cells(i, "AQ")) = 1 Then ComboBox1.AddItem Sayfa1.Cells(i, "AQ").Value
If WorksheetFunction.CountIf(Sayfa1.Range("A2:A" & i), Sayfa1.Cells(i, "A")) = 1 Then ComboBox2.AddItem Sayfa1.Cells(i, "A").Value
If WorksheetFunction.CountIf(Sayfa1.Range("B2:B" & i), Sayfa1.Cells(i, "B")) = 1 Then ComboBox4.AddItem Sayfa1.Cells(i, "B").Value
If WorksheetFunction.CountIf(Sayfa1.Range("D2:D" & i), Sayfa1.Cells(i, "D")) = 1 Then ComboBox5.AddItem Sayfa1.Cells(i, "D").Value
'If WorksheetFunction.CountIf(Sayfa1.Range("C2:C" & i), Sayfa1.Cells(i, "C")) = 1 Then ComboBox3.AddItem Sayfa1.Cells(i, "C").Value
combo3.Item(Sayfa1.Cells(i, "C").Value) = Sayfa1.Cells(i, "C").Value
Next

ComboBox3.List = combo3.Items
Application.ScreenUpdating = True
Set combo3 = Nothing
End Sub
Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 19:36
Konum: Almanya
Meslek: İşçi
Yaş: 39
İleti: 5167
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray

Cevap: ComboBox Süzme sorunu

İleti#4)  kanakan52 » 01 May 2018 10:03

Sayın Orion1 merhaba,
Vba şifresi : 6773436 . Belirtmeyi unutmuşum özür dilerim.

Sayın Feraz kodlar için teşekkür ederim.
Maalesef Combo3 yine süzme yapmıyor. Ben mi bir şeyleri yanlış yapıyorum. Görseldeki gibi oluyor.
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
kanakan52
Siteye Alışmış
 
Adı Soyadı:Ümit AKBULUT
Kayıt: 15 May 2013 17:56
Konum: TÜRKİYE
Meslek: muhasebe
Yaş: 35
İleti: 344
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: ORDU

REKLAM
Excel Logo XML Oluşturucu
Logo Object Designer ile Uyarlama

Cevap: ComboBox Süzme sorunu

İleti#5)  feraz » 01 May 2018 12:27

Merhaba.

Benim kod userform açılışında combo3 e benzersiz veri alıyor.

Diğer comboboxları seçince combo3 olayına bakmamıştım.

Mantık aynıdır zaten.Pc yi açınca bakarım.
Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 19:36
Konum: Almanya
Meslek: İşçi
Yaş: 39
İleti: 5167
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray

Cevap: ComboBox Süzme sorunu

İleti#6)  kanakan52 » 01 May 2018 12:30

Forumdan ayrılmıyorum bir yardım gelecek diye :) Çok makbule geçecek Sn. Feraz.. Teşekkürler.
Kullanıcı avatarı
kanakan52
Siteye Alışmış
 
Adı Soyadı:Ümit AKBULUT
Kayıt: 15 May 2013 17:56
Konum: TÜRKİYE
Meslek: muhasebe
Yaş: 35
İleti: 344
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: ORDU

REKLAM
ETA - Excel Konsolide Raporlama
ETA Excel Personel Entegre Raporu

Cevap: ComboBox Süzme sorunu

İleti#7)  feraz » 01 May 2018 12:45

Rica ederiz Ümit Bey :)

Deneyiniz.Aynı mantıkla yaptım.

Kod: Tümünü seç
Private Sub ComboBox4_Change()

Dim combo3 As Object
Set combo3 = CreateObject("Scripting.Dictionary")

ComboBox3.Clear
For i = 2 To Sayfa1.[A65536].End(3).Row
  If Sayfa1.Cells(i, "A").Text = ComboBox2.Text And Sayfa1.Cells(i, "B").Text = ComboBox4.Text Then
   For a = 0 To ComboBox3.ListCount - 1
        If Sayfa1.Cells(i, "B").Value = ComboBox3.List(a, 0) Then
          evn = True
          Exit For
        Else
          evn = False
        End If
    Next
        If evn = False Then
          combo3.Item(Sayfa1.Cells(i, "C").Value) = Sayfa1.Cells(i, "C").Value
        End If
          evn = False
End If
Next
ComboBox3.List = combo3.Items
Set combo3 = Nothing

End Sub
Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 19:36
Konum: Almanya
Meslek: İşçi
Yaş: 39
İleti: 5167
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray

Cevap: ComboBox Süzme sorunu

İleti#8)  kanakan52 » 01 May 2018 12:58

şkşk --)( --)( [TESEKKÜR]


Ellerinize sağlık. Ümidimi kesmiştim. Allah razı olsun..
Kullanıcı avatarı
kanakan52
Siteye Alışmış
 
Adı Soyadı:Ümit AKBULUT
Kayıt: 15 May 2013 17:56
Konum: TÜRKİYE
Meslek: muhasebe
Yaş: 35
İleti: 344
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: ORDU

Cevap: ComboBox Süzme sorunu

İleti#9)  feraz » 01 May 2018 13:03

Sizdende.

Userform açılışında çoklu veride yavaş açılmaması için kod eklerim birazdan denersiniz onuda.

Bence öyle daha hızlı olur.
Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 19:36
Konum: Almanya
Meslek: İşçi
Yaş: 39
İleti: 5167
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray

Cevap: ComboBox Süzme sorunu

İleti#10)  kanakan52 » 01 May 2018 13:23

Çok makbule geçer. Bende projeyi tamamlayıp paylaşırım. Belki birilerinin işine yarar..
Kullanıcı avatarı
kanakan52
Siteye Alışmış
 
Adı Soyadı:Ümit AKBULUT
Kayıt: 15 May 2013 17:56
Konum: TÜRKİYE
Meslek: muhasebe
Yaş: 35
İleti: 344
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: ORDU

Cevap: ComboBox Süzme sorunu

İleti#11)  feraz » 01 May 2018 14:01

Private Sub userform_Initialize() kodunu silip alttaki kodu ekleyin.

Function kodunuda boş bir yere ekleyin alfabetik sıralama için.
Bu kodlar userform açılışı için sadece.Hem hızlı çalışır hemde alfabetik sıralama yapar.
Comboboxların değiştirilme olayına görede aynı mantıkla uygulanabilinir.

5000 satır için userform açılma süresi bende 1 veya 2 saniye sürdü.



Kod: Tümünü seç
Private Sub userform_Initialize()

Dim combo2 As Object, combo3 As Object, combo4 As Object, a, b, c

Set combo2 = CreateObject("Scripting.Dictionary")
Set combo3 = CreateObject("Scripting.Dictionary")
Set combo4 = CreateObject("Scripting.Dictionary")

Application.ScreenUpdating = True
    For i = 2 To Sayfa1.[A65536].End(3).Row
        combo2.Item(Sayfa1.Cells(i, "A").Value) = Sayfa1.Cells(i, "A").Value
        combo3.Item(Sayfa1.Cells(i, "C").Value) = Sayfa1.Cells(i, "C").Value
        combo4.Item(Sayfa1.Cells(i, "B").Value) = Sayfa1.Cells(i, "B").Value
    Next
   
      a = combo2.items
      b = combo3.items
      c = combo4.items
        Call xx(a)
        Call xx(b)
        Call xx(c)
    On Error Resume Next
     ComboBox2.List = a
     ComboBox3.List = b
     ComboBox4.List = c
Application.ScreenUpdating = True

Set combo2 = Nothing: Set combo3 = Nothing: Set combo4 = Nothing: Erase a: Erase b: Erase c

End Sub

Kod: Tümünü seç
Function xx(yy As Variant)

       For i = LBound(yy) To UBound(yy) - 1
        For j = i + 1 To UBound(yy)
            If StrComp(yy(i), yy(j), vbTextCompare) = 1 Then
                x = yy(j)
                yy(j) = yy(i)
                yy(i) = x
            End If
        Next j
    Next i

End Function
Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 19:36
Konum: Almanya
Meslek: İşçi
Yaş: 39
İleti: 5167
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray

Cevap: ComboBox Süzme sorunu

İleti#12)  kanakan52 » 01 May 2018 14:24

Sayın Feraz,
Rutin işlerimi bitirip kodlarınızı deneyip bilgi vereceğim. Dediğiniz gibiyse çok süper olacak inşallah.
Sağolun.
Kullanıcı avatarı
kanakan52
Siteye Alışmış
 
Adı Soyadı:Ümit AKBULUT
Kayıt: 15 May 2013 17:56
Konum: TÜRKİYE
Meslek: muhasebe
Yaş: 35
İleti: 344
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: ORDU

Cevap: ComboBox Süzme sorunu

İleti#13)  feraz » 01 May 2018 19:02

Birde alttaki gibi kısa kod var.Bunun çalışması için Microsoft .NET Framework 2.0 yüklü olması gerekmiş bilgisayarda.

Kodları denersiniz bence bu kod daha iyi gibi.Kodlar sadece Userform açılışı için.

https://www.microsoft.com/tr-TR/download/details.aspx?id=1639


Kod: Tümünü seç
Private Sub userform_Initialize()

Dim objArrLst, objArrLst1, objArrLst2, i As Long

Set objArrLst = CreateObject("System.collections.arraylist")
Set objArrLst1 = CreateObject("System.collections.arraylist")
Set objArrLst2 = CreateObject("System.collections.arraylist")

On Error Resume Next

Application.ScreenUpdating = False

With Sheets("DATA2")

    For i = 2 To .Cells(Rows.Count, "A").End(3).Row
        If Not objArrLst.contains(.Cells(i, "A").Value) And .Cells(i, "A").Value <> "" Then
            objArrLst.Add .Cells(i, "A").Value
         End If
         
        If Not objArrLst1.contains(.Cells(i, "B").Value) And .Cells(i, "B").Value <> "" Then
            objArrLst1.Add .Cells(i, "B").Value
        End If
       
         If Not objArrLst2.contains(.Cells(i, "C").Value) And .Cells(i, "C").Value <> "" Then
            objArrLst2.Add .Cells(i, "C").Value
        End If
         
    Next

objArrLst.Sort
objArrLst1.Sort
objArrLst2.Sort

ComboBox2.List = objArrLst.ToArray
ComboBox4.List = objArrLst1.ToArray
ComboBox3.List = objArrLst2.ToArray

End With
Application.ScreenUpdating = True

Set objArrLst = Nothing: Set objArrLst1 = Nothing: Set objArrLst1 = Nothing

End Sub
Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 19:36
Konum: Almanya
Meslek: İşçi
Yaş: 39
İleti: 5167
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray

Cevap: ComboBox Süzme sorunu

İleti#14)  kanakan52 » 07 May 2018 14:16

Sayın Feraz,
Son kodlarınızı deneme fırsatım olmadı. Daha doğrusu bir önceki kodlarınız stabil çalıştığı için macera aramanın anlamı yok diye düşündüm.. Emeğinize çok çok teşekkür ediyorum... Allah razı olsun.
Kullanıcı avatarı
kanakan52
Siteye Alışmış
 
Adı Soyadı:Ümit AKBULUT
Kayıt: 15 May 2013 17:56
Konum: TÜRKİYE
Meslek: muhasebe
Yaş: 35
İleti: 344
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: ORDU

Cevap: ComboBox Süzme sorunu

İleti#15)  feraz » 07 May 2018 15:18

Sizdende üstad.

Sadece son kodun farkı sıralama yapıyordu.

Yoksa aynı işi görür zaten.

Kolay gelsin.
Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 19:36
Konum: Almanya
Meslek: İşçi
Yaş: 39
İleti: 5167
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray

Cevap: ComboBox Süzme sorunu

İleti#16)  kanakan52 » 07 May 2018 15:30

Teşekkür ederim çok sağolun..
Kullanıcı avatarı
kanakan52
Siteye Alışmış
 
Adı Soyadı:Ümit AKBULUT
Kayıt: 15 May 2013 17:56
Konum: TÜRKİYE
Meslek: muhasebe
Yaş: 35
İleti: 344
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: ORDU


Forum ComboBox

Online Kullanıcılar

Bu forumu görüntüleyenler: Kayıtlı kullanıcı yok ve 1 misafir

cron
Bumerang - Yazarkafe