Combobox'a benzersiz ve alfabetik veri almak

[ali8686]

Combobox'a benzersiz ve alfabetik veri almak (birden çok sütundan)

Selam arkadaşlar,

Benzersiz kayıtlarla ilgili Userform Initialize kısmına yazılabilecek çok örnek var ama hepsi sadece tek sütun'dan veri alındığında kullanılan kodlar, örneğin A sütunu. Ben 4 sütundan (A,B,C,D) aşağıdaki kod ile veri çekiyorum. Boş ve tekrarlı hücreleri combobox'a almamak ve combobox'a alfabetik sıralama için ne yapılabilir? Nasıl bi kod kullanmalıyım?

For k = 1 To 4
For i = 1 To 65536
If Cells(i, 1) <> "" Then
ComboBox4.AddItem
ComboBox4.Column(0, x) = Cells(i, k)
x = x + 1
End If
Next
Next

 

[Orion1]

Ben bu konu ile ilgili çok mikatrda cevap lar verdim.
Yani var forumda bunlar.
Siz iyi arayamamışsınız.
aşağıdaki kodu userformun declare(GENERAL) kısmına yapıştırın

Option Base 1

aşağıdakinide userformun initialize kısmına.:

A sütunundaki mükerreliği sorgular ve A sütunundaki boşlukları sorgular.

Private Sub UserForm_Initialize()
Dim list(), myarr(), z As Object, n As Long, i As Long, k As Byte
Dim sat As Long, deg As String, j As Long, x As Variant
sat = Cells(65536, "A").End(xlUp).Row
list = Range("A1:D" & sat).Value
ReDim myarr(1 To 4, 1 To sat)
Set z = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(list, 1)
    deg = UCase(Replace(Replace(list(i, 1), "ı", "I"), "i", "İ"))
    If deg <> "" And Not z.exists(deg) Then
        n = n + 1
        z.Add deg, n
        For k = 1 To 4
            myarr(k, n) = list(i, k)
        Next
    End If
Next i
Erase list
Set z = Nothing
ReDim Preserve myarr(1 To 4, 1 To n)
For i = 1 To UBound(myarr, 2) - 1
    For j = i + 1 To UBound(myarr, 2)
        If StrComp(myarr(1, i), myarr(1, j), vbTextCompare) > 0 Then
            For k = 1 To 4
                x = myarr(k, i)
                myarr(k, i) = myarr(k, j)
                myarr(k, j) = x
            Next
        End If
    Next
Next
ComboBox1.Column = myarr
If ComboBox1.ListCount > 0 Then ComboBox1.ListIndex = 0
Erase myarr
End Sub

Selam arkadaşlar,

Benzersiz kayıtlarla ilgili Userform Initialize kısmına yazılabilecek çok örnek var ama hepsi sadece tek sütun'dan veri alındığında kullanılan kodlar, örneğin A sütunu. Ben 4 sütundan (A,B,C,D) aşağıdaki kod ile veri çekiyorum. Boş ve tekrarlı hücreleri combobox'a almamak ve combobox'a alfabetik sıralama için ne yapılabilir? Nasıl bi kod kullanmalıyım?

For k = 1 To 4
For i = 1 To 65536
If Cells(i, 1) <> "" Then
ComboBox4.AddItem
ComboBox4.Column(0, x) = Cells(i, k)
x = x + 1
End If
Next
Next

 

[ali8686]

Evren Bey teşekkürler kodu denedim ancak nedendir bilmiyorum hala aynı şekilde almaya devam ediyor.

Ayrıca
ReDim Preserve myarr(1 To 4, 1 To n) satırında subscript out of range hatası veriyor. n yerine 10 yazıyorum ama gene çalışmıyor kod.

 

[Orion1]

Evren Bey teşekkürler kodu denedim ancak nedendir bilmiyorum hala aynı şekilde almaya devam ediyor.

Ayrıca
ReDim Preserve myarr(1 To 4, 1 To n) satırında subscript out of range hatası veriyor. n yerine 10 yazıyorum ama gene çalışmıyor kod.

Gelmez.
Siz yapamıyorsunuz.
Örnek bir dosya yolayın.40- 50 satırlık.
Ben yapayım yolayım size.

 

[ali8686]

Dosya ekte Evren Bey,

Önce Cari Adı seçiyoruz.

Cari adı seçtikten sonra Görüsülen Kişi 1 Combobox'ının benzersiz ve alfabetik veri almasını istiyorum.

 

[Orion1]

Dosya ekte Evren Bey,

Önce Cari Adı seçiyoruz.

Cari adı seçtikten sonra Görüsülen Kişi 1 Combobox'ının benzersiz ve alfabetik veri almasını istiyorum.

Dosyanızı 2003(xls9 formatında yollayın.Bende 2007 yok.

 

[ali8686]

Buyrun Evren Bey.

Gerçi 2003'e çevirince uyumluluk hataları çıkacaktır diye tahmin ediyorum.

 

[Orion1]

Dosyanız ektedir.
B-C-D-E sütununa göre çalışır combobox.
Bakın altını çizdim.
Sonra olmuyor demeyin.
Ne istediğinizi tam olarak anlatmazsanız nasıl yaoparım.
Eğer 4 sütunuda mükerrelik kontrolu istyorsanzı söymlemeniz lazım.
Problem değil.yaparım.Yeterki siz doğru sorun sorunuzu.
Başka limanlarda dolaşmayalım.

 

[ali8686]

Evet Evren bey, 4 sütunun tamamı için çalışması gerekiyor. Örneğin ekteki resimde verdiğim tabloyu combobox'a aldığımda:


aşağıdaki şekilde çıkarmalı. Yani 4 sütundaki tüm verileri kendi arasında karşılaştıracak. Umarım açıklayıcı olmuştur. Bu arada sizi bayaa uğraştırdım kusura bakmayın


Ali
Mehmet
Kemal
Sinan
Özge
Kemal
Deniz

 

[Orion1]

Dosyayı günceledim.
8 numaralı mesajdan indirebilirsiniz.

Evet Evren bey, 4 sütunun tamamı için çalışması gerekiyor. Örneğin ekteki resimde verdiğim tabloyu combobox'a aldığımda:


aşağıdaki şekilde çıkarmalı. Yani 4 sütundaki tüm verileri kendi arasında karşılaştıracak. Umarım açıklayıcı olmuştur. Bu arada sizi bayaa uğraştırdım kusura bakmayın


Ali
Mehmet
Kemal
Sinan
Özge
Kemal
Deniz

 

[ali8686]

Valla Evren Bey artık utanarak yazıyorum olmuyor diye sanırım çok detaylı anlatmadım sorun ordan kaynaklanıyor. Cari adı combobox'ından bir şirket seçtiğimde (ComboBox5 click) access'ten Sayfa1'e sorgu ile isimleri alıyorum. Ama bu isimleri combobox4'e almak istediğimde dediğim sorunla karşılaşıyorum. Sizin gönderdiğiniz yazdırma sayfasını referans alıyor ve combobox4 için columncount 4. bana tek sütunlu bütün verileri tekrarsız alfabetik içeren bir Combobox4 lazım.

Yani sayfayı ilk açtığımızda Sayfa1 boş. Combobox 5 ile firma seçiyorum. Sayfa 1'e 4 sütun halinde görüşülen kişilerin isimleri geliyor. Combobox4 ile bu 4 sütundaki elemanların adını almak istiyorum.

Artık uğraşamicam derseniz dicek sözüm yok

 

[excelapachi]

Ben bu konu ile ilgili çok mikatrda cevap lar verdim.
Yani var forumda bunlar.
Siz iyi arayamamışsınız.
aşağıdaki kodu userformun declare(GENERAL) kısmına yapıştırın

Option Base 1

aşağıdakinide userformun initialize kısmına.:

A sütunundaki mükerreliği sorgular ve A sütunundaki boşlukları sorgular.

Private Sub UserForm_Initialize()
Dim list(), myarr(), z As Object, n As Long, i As Long, k As Byte
Dim sat As Long, deg As String, j As Long, x As Variant
sat = Cells(65536, "A").End(xlUp).Row
list = Range("A1:D" & sat).Value
ReDim myarr(1 To 4, 1 To sat)
Set z = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(list, 1)
    deg = UCase(Replace(Replace(list(i, 1), "ı", "I"), "i", "İ"))
    If deg <> "" And Not z.exists(deg) Then
        n = n + 1
        z.Add deg, n
        For k = 1 To 4
            myarr(k, n) = list(i, k)
        Next
    End If
Next i
Erase list
Set z = Nothing
ReDim Preserve myarr(1 To 4, 1 To n)
For i = 1 To UBound(myarr, 2) - 1
    For j = i + 1 To UBound(myarr, 2)
        If StrComp(myarr(1, i), myarr(1, j), vbTextCompare) > 0 Then
            For k = 1 To 4
                x = myarr(k, i)
                myarr(k, i) = myarr(k, j)
                myarr(k, j) = x
            Next
        End If
    Next
Next
ComboBox1.Column = myarr
If ComboBox1.ListCount > 0 Then ComboBox1.ListIndex = 0
Erase myarr
End Sub

Çok teşekkürler bende böyle birşey arıyordum. Elinize sağlık

 

[excelapachi]

Bu kodu kitap içinde çoğaltmak istiyorum. Sayfa1, Sayfa ... ve farklı farklı formlarda kullanmak istiyorum ama kodda sayfa 1 diye bir yer geçmiyor. Bunu anlayamadım.

 

[ali8686]

Bu kodu kitap içinde çoğaltmak istiyorum. Sayfa1, Sayfa ... ve farklı farklı formlarda kullanmak istiyorum ama kodda sayfa 1 diye bir yer geçmiyor. Bunu anlayamadım.

Yazdırma sayfası diye geçen yerlere kendi sayfa isminizi yazın. Hallolacaktır.