Combobox'a Benzersiz Veri Alma Hakkında

[Ergün Güler]

Selam Arkadaşlar,
Sayfa1'e bir tane commbobox koydum. aşağıdaki kod ile A sütunundan benzersiz veri almak istedim. İlk çalıştırdığımda benzersiz alıyor. Ancak, her çalıştırmada yine aynısını ekliyor. Problemi nasıl çözebiliriz?

Private Sub ComboBox1_Change()
Set s = Sheets("Sayfa1")
For i = 1 To s.[A65536].End(3).Row
If WorksheetFunction.CountIf(s.Range("A1:A" & i), s.Cells(i, "A")) = 1 Then
ComboBox1.AddItem s.Cells(i, "A").Value
End If
Next i
End Sub

 

[Orion1]

bu kodu change olayına değlde autoopen prosederüne veya sayfa aktivite olayına yazmalısınız.
Birde kodun en üstüne sheets("Sayfa1").combobox1.clear yazarak önce combonun içini temizlemelisiniz.

 

[Ergün Güler]

bu kodu change olayına değlde autoopen prosederüne veya sayfa aktivite olayına yazmalısınız.
Birde kodun en üstüne sheets("Sayfa1").combobox1.clear yazarak önce combonun içini temizlemelisiniz.

Sayın Evren Gizlen,
Yardımlarınız için çok teşekkür ederim.

Sayenizde aşağıdaki gibi yaptım;

Private Sub Worksheet_Activate()

Sheets("Sayfa1").ComboBox1.Clear
Sheets("Sayfa1").ComboBox2.Clear
ComboBox1.AddItem ""
ComboBox2.AddItem ""

Set s = Sheets("Sayfa1")
For i = 1 To s.[A65536].End(3).Row
If WorksheetFunction.CountIf(s.Range("A1:A" & i), s.Cells(i, "A")) = 1 Then
ComboBox1.AddItem s.Cells(i, "A").Value
End If
Next i


For j = 1 To s.[B65536].End(3).Row
If WorksheetFunction.CountIf(s.Range("B1:B" & j), s.Cells(j, "B")) = 1 Then
ComboBox2.AddItem s.Cells(j, "B").Value
End If
Next j

End Sub

Bir kaç soru sorabilir miyim;
birincisi; alfabetik benzersiz nasıl sıralayabilirim?

ikincisi;
'Private Sub Worksheet_SelectionChange(ByVal Target As Range)
ile
'Private Sub Worksheet_Change(ByVal Target As Range)

arasındaki fark nedir pek anlayamadım?

 

[Orion1]

Onların hepsini silin aşağıdakileri yapıştırın.
Not: Değerlerin string olduğu kabul edilmiştir.

Public Function sirala(liste)
Dim i As Long, j As Long, x
For i = LBound(liste) To UBound(liste) - 1
    For j = i + 1 To UBound(liste)
        If StrComp(liste(i, 0), liste(j, 0)) > 0 Then
            x = liste(i, 0)
            liste(i, 0) = liste(j, 0)
            liste(j, 0) = x
        End If
    Next j
Next i
sirala = liste
End Function
Private Sub Worksheet_Activate()
Dim liste
Sheets("Sayfa1").ComboBox1.Clear
Sheets("Sayfa1").ComboBox2.Clear
ComboBox1.AddItem ""
ComboBox2.AddItem ""

Set s = Sheets("Sayfa1")
For i = 1 To s.[A65536].End(3).Row
If WorksheetFunction.CountIf(s.Range("A1:A" & i), s.Cells(i, "A")) = 1 Then
ComboBox1.AddItem s.Cells(i, "A").Value
End If
Next i
If s.ComboBox1.ListCount > 0 Then
    liste = ComboBox1.List
    s.ComboBox1.List = sirala(liste)
End If

For j = 1 To s.[B65536].End(3).Row
If WorksheetFunction.CountIf(s.Range("B1:B" & j), s.Cells(j, "B")) = 1 Then
ComboBox2.AddItem s.Cells(j, "B").Value
End If
Next j
If s.ComboBox2.ListCount > 0 Then
    liste = ComboBox2.List
    s.ComboBox2.List = sirala(liste)
End If
End Sub

 

[Ergün Güler]

Sayın Evren Gizlen,
Süper olmuş. ellerinize sağlık.Çok teşekkür ederim.
aşağıdaki sıralama kısmıni nceledim. Nasıl çalıştığını pek anlayamadım. Mümkünse biraz izah edebilir misiniz?
Bir de bir dosya hazırlıyorum. Yine aynı konu ile ilgili karşılaştığım problemleri aynı başlık altında yani burada sorabilir miyiz?

Public Function sirala(liste)
Dim i As Long, j As Long, x
For i = LBound(liste) To UBound(liste) - 1
    For j = i + 1 To UBound(liste)
        If StrComp(liste(i, 0), liste(j, 0)) > 0 Then
            x = liste(i, 0)
            liste(i, 0) = liste(j, 0)
            liste(j, 0) = x
        End If
    Next j
Next i
sirala = liste
End Function

 

[Ergün Güler]

Sayın Evren Gizlen,
2 ayrı combobox'a ve benzersiz alfabetik sıralı veri alabiliyorum.
Ancak 2'den fazla combobox'a yapamadım.
Aşağıdaki sıralama kısmını inceledim. Nasıl çalıştığını pek anlayamadım.
Zaten bu yüzden beceremedim.

Public Function sirala(liste)
Dim i As Long, j As Long, x
For i = LBound(liste) To UBound(liste) - 1
    For j = i + 1 To UBound(liste)
        If StrComp(liste(i, 0), liste(j, 0)) > 0 Then
            x = liste(i, 0)
            liste(i, 0) = liste(j, 0)
            liste(j, 0) = x
        End If
    Next j
Next i
sirala = liste
End Function

Combobox1 A sütunundan
Combobox2 B sütunundan
Combobox3 G sütunundan
Combobox4 H sütunundan
Combobox5 I sütunundan
Combobox6 J sütunundan
benzersiz ve alfabetik sıralı benzersiz veri aldığımızı düşünürsek ne yapmamız gerekir? Yardımcı olabilirseniz çok sevinirim.

Daha sonra 4.mesajınızdaki
Private Sub Worksheet_Activate()
altındaki kodları kendim de düzenleyebilirim sanırım.
İyi çalışmalar.

 

[Orion1]

Sayın Evren Gizlen,
2 ayrı combobox'a ve benzersiz alfabetik sıralı veri alabiliyorum.
Ancak 2'den fazla combobox'a yapamadım.
Aşağıdaki sıralama kısmını inceledim. Nasıl çalıştığını pek anlayamadım.
Zaten bu yüzden beceremedim.
Combobox1 A sütunundan
Combobox2 B sütunundan
Combobox3 G sütunundan
Combobox4 H sütunundan
Combobox5 I sütunundan
Combobox6 J sütunundan
benzersiz ve alfabetik sıralı benzersiz veri aldığımızı düşünürsek ne yapmamız gerekir? Yardımcı olabilirseniz çok sevinirim.

Daha sonra 4.mesajınızdaki
Private Sub Worksheet_Activate()
altındaki kodları kendim de düzenleyebilirim sanırım.
İyi çalışmalar.

Alabilirsiniz.O kodları ben yazdım.Siz üstüne bir şey koymamışsınız.(Diğer comboboxlar için diyorum)
Diğerleri içinde ayni işlemleri takip ediniz.
Not : fonksiyona bir şey yapmayınız.O fonksiyom hepsi için geçerli.Artan sırama yapıyor.
Ancak azalan sıaralma yapmak gerekirse değiştirmek gerekir.
Worksheetactivite içindeki combolara veri alıp fonksiyonu orada kullanınız.

 

[Ergün Güler]

Alabilirsiniz.O kodları ben yazdım.Siz üstüne bir şey koymamışsınız.(Diğer comboboxlar için diyorum)
Diğerleri içinde ayni işlemleri takip ediniz.
Not : fonksiyona bir şey yapmayınız.O fonksiyom hepsi için geçerli.Artan sırama yapıyor.
Ancak azalan sıaralma yapmak gerekirse değiştirmek gerekir.
Worksheetactivite içindeki combolara veri alıp fonksiyonu orada kullanınız.

Sayın Gizlen,
Yardımlarınız için çok teşekkür ederim. Kusura bakmayınız, Ben Public Sub'daki i ve j'leri diğer kodlardaki i ve j'ler ile aynı zannnetmiştim.
Dediğiniz gibi, "sirala" makrosunu ellemedim. sadece diğer kodları aşağıdaki gibi çoğaltım:

'********Sayfa değerleri için********
For k = 3 To s1.[H65536].End(3).Row
If WorksheetFunction.CountIf(s1.Range("H3:H" & k), s1.Cells(k, "H")) = 1 Then
s2.Sayfa.AddItem s1.Cells(k, "H").Value
End If
Next k
If s2.Sayfa.ListCount > 0 Then
    liste = s2.Sayfa.List
  s2.Sayfa.List = sirala(liste)
End If
'********Yaprak değerleri için********
For l = 3 To s1.[I65536].End(3).Row
If WorksheetFunction.CountIf(s1.Range("I3:I" & l), s1.Cells(l, "I")) = 1 Then
s2.Yaprak.AddItem s1.Cells(l, "I").Value
End If
Next l
If s2.Yaprak.ListCount > 0 Then
    liste = s2.Yaprak.List
  s2.Yaprak.List = sirala(liste)
End If
'********gsm değerleri için********
For m = 3 To s1.[J65536].End(3).Row
If WorksheetFunction.CountIf(s1.Range("J3:J" & m), s1.Cells(m, "J")) = 1 Then
s2.gsm.AddItem s1.Cells(m, "J").Value
End If
Next m
If s2.gsm.ListCount > 0 Then
    liste = s2.gsm.List
  s2.gsm.List = sirala(liste)
End If

bir kaç sorum olacak;
birincisi;
Combobox'un veri aldığı sütundaki sayılar 1,10,2,20,24 gibi sıralanıyor.
1,2,10,20,24 gibi nasıl sıralaya bilirim?
ikinci sorum;
Combobox'un veri aldığı sütundaki sayılar 2 Sayfa, 4 Sayfa, 6 Sayfa gibi biçimlenidirilmiş olmasına rağmen Combobox'ta sadece 2,4,6 diye görünüyor.
bunu nasıl düzeltebiliriz?
üçüncü sorum;
metinleri alfebetik sıralar iken küçük harf ile başlaylarını ve Büyük harf ile başlayan Türkçe karakterleri sıraya sokmuyor, en sonda kendi aralarında sıraya sokuyor.
Şöyle ki;
TownCenter
Yaylakent
ergün
deneme
zeynep
Çetinkaya
Özkuruşlar
İnşaat-Emlak
bunu nasıl düzeltebiliriz? Yardımcı oabilirseniz çok sevinirim.
İyi çalışmalar.

 

[Orion1]

Sayın Gizlen,
Yardımlarınız için çok teşekkür ederim. Kusura bakmayınız, Ben Public Sub'daki i ve j'leri diğer kodlardaki i ve j'ler ile aynı zannnetmiştim.
Dediğiniz gibi, "sirala" makrosunu ellemedim. sadece diğer kodları aşağıdaki gibi çoğaltım:

'********Sayfa değerleri için********
For k = 3 To s1.[H65536].End(3).Row
If WorksheetFunction.CountIf(s1.Range("H3:H" & k), s1.Cells(k, "H")) = 1 Then
s2.Sayfa.AddItem s1.Cells(k, "H").Value
End If
Next k
If s2.Sayfa.ListCount > 0 Then
    liste = s2.Sayfa.List
  s2.Sayfa.List = sirala(liste)
End If
'********Yaprak değerleri için********
For l = 3 To s1.[I65536].End(3).Row
If WorksheetFunction.CountIf(s1.Range("I3:I" & l), s1.Cells(l, "I")) = 1 Then
s2.Yaprak.AddItem s1.Cells(l, "I").Value
End If
Next l
If s2.Yaprak.ListCount > 0 Then
    liste = s2.Yaprak.List
  s2.Yaprak.List = sirala(liste)
End If
'********gsm değerleri için********
For m = 3 To s1.[J65536].End(3).Row
If WorksheetFunction.CountIf(s1.Range("J3:J" & m), s1.Cells(m, "J")) = 1 Then
s2.gsm.AddItem s1.Cells(m, "J").Value
End If
Next m
If s2.gsm.ListCount > 0 Then
    liste = s2.gsm.List
  s2.gsm.List = sirala(liste)
End If

bir kaç sorum olacak;
birincisi;
Combobox'un veri aldığı sütundaki sayılar 1,10,2,20,24 gibi sıralanıyor.
1,2,10,20,24 gibi nasıl sıralaya bilirim?
ikinci sorum;
Combobox'un veri aldığı sütundaki sayılar 2 Sayfa, 4 Sayfa, 6 Sayfa gibi biçimlenidirilmiş olmasına rağmen Combobox'ta sadece 2,4,6 diye görünüyor.
bunu nasıl düzeltebiliriz?
üçüncü sorum;
metinleri alfebetik sıralar iken küçük harf ile başlaylarını ve Büyük harf ile başlayan Türkçe karakterleri sıraya sokmuyor, en sonda kendi aralarında sıraya sokuyor.
Şöyle ki;
TownCenter
Yaylakent
ergün
deneme
zeynep
Çetinkaya
Özkuruşlar
İnşaat-Emlak
bunu nasıl düzeltebiliriz? Yardımcı oabilirseniz çok sevinirim.
İyi çalışmalar.

Public Function sirala_sayi(liste)
Dim i As Long, j As Long, x
For i = LBound(liste) To UBound(liste) - 1
    For j = i + 1 To UBound(liste)
        If CDbl(liste(i, 0)) > CDbl(liste(j, 0)) Then
            x = liste(i, 0)
            liste(i, 0) = liste(j, 0)
            liste(j, 0) = x
        End If
    Next j
Next i
sirala_sayi = liste
End Function

1-Sayı sıaramak için yukarıdaki fonksiyonu kullanın.
kullanılışı:

liste = ComboBox1.List
ComboBox1.List = sirala_sayi(liste)

küçük büyük harfe duyarsız kullanmak için aşağıdaki fonksiyonu kullanın
Public Function sirala_txt(liste)
Dim i As Long, j As Long, x
For i = LBound(liste) To UBound(liste) - 1
For j = i + 1 To UBound(liste)
If StrComp(liste(i, 0), liste(j, 0), vbTextCompare) > 0 Then
x = liste(i, 0)
liste(i, 0) = liste(j, 0)
liste(j, 0) = x
End If
Next j
Next i
sirala_txt = liste
End Function
kullanılışı:

liste = ComboBox1.List
ComboBox1.List = sirala_txt(liste)

Sayıları istediğiniz gibi biçimlendiriniz onu alırken yine sayı olarak alır.
ama aşğaıdaki gibi alarak sonrada text sıaralaması yapabilirsiniz.

ComboBox1.Value = "Sayfa" & Range("A1").Value

 

[Ergün Güler]

Sayın Evren Gizlen,
Çok teşekkür ederim. sirala_txt(liste) tam istediğim gibi çalışıyor. Hem türkçe hem de küçük büyük sıralıyabiliyor. Ancak,
sirala_sayi(liste) aşağıdaki kırmızı alanda kod hatası veriyor;

Public Function sirala_sayi(liste)
Dim i As Long, j As Long, x
For i = LBound(liste) To UBound(liste) - 1
For j = i + 1 To UBound(liste)
If CDbl(liste(i, 0)) > CDbl(liste(j, 0)) Then
x = liste(i, 0)
liste(i, 0) = liste(j, 0)
liste(j, 0) = x
End If
Next j
Next i
sirala_sayi = liste
End Function

Nasıl düzeltebiliriz?

 

[Orion1]

Sayın Evren Gizlen,
Çok teşekkür ederim. sirala_txt(liste) tam istediğim gibi çalışıyor. Hem türkçe hem de küçük büyük sıralıyabiliyor. Ancak,
sirala_sayi(liste) aşağıdaki kırmızı alanda kod hatası veriyor;

Nasıl düzeltebiliriz?
Kesinlikle comboboxa aldığınız veriler içinde sayı olmayan içinde metin karakteri olan bir değer var.
hata verdiğinde i yazan yere mousun imlecini yaklaştırın i=4 veya 1yazacak
inin karşısında yazdığı değer comboboxın indexi dir o değeri kontrol edin.Bunun çalışması için mutlaka sayısal değerler olmalıdır.İçinde metin geçen değerler veya boş olan değerleri metin olarak algılar.Eğer boşsa combobox değerleri sayfadan alıyorsa sayfaya o hücreye 0 yazın veya comboya addd item ile o hücreyi alırken konrtrol edin boşsa comboya 0 olarak alın.

Bunlardan ben hiç bir anlam çıkaramadım.
Ne oldu sonuç?
Düzeldimi?

 

[Ergün Güler]

Bunlardan ben hiç bir anlam çıkaramadım.
Ne oldu sonuç?
Düzeldimi?

Selam Sayın Gizlen,
Çok teşekkür ederim. Dediğiniz gibi metin aradım bulmadım. Sayılar fonksiyonlar sonucu geldiğinden zannettim. O da değilmiş. Problem aşağıdaki koddaki kırmızı lanadan kaynaklanıyormuş. Sayfa aktif olduğunda combobox'lara liste harici bir de ben boş eklemiştim. bunları iptal edince sorun düzeldi.
Ellerinize sağlık sirala_sayi(liste) fonksiyonu da tam istediğim gibi çalışıyor.
tam istediğim gibi.
Sizlere ne kadar çok teşekkür azdır.

Private Sub Worksheet_Activate()
Call sorguyeri
Dim liste

operator.Clear
insort.Clear
format.Clear
ebat.Clear
Sayfa.Clear
Yaprak.Clear
gsm.Clear

insort.AddItem ""
ebat.AddItem ""
[B][COLOR="Red"]'Sayfa.AddItem ""
'Yaprak.AddItem ""
'gsm.AddItem ""[/COLOR][/B]

insort ve ebat'taki gibi Sayfa,Yaprak ve gsm comboboxları içinde, en başta bir tane boş nasıl verebilirim?
Not: Birşey soracağım siz benim 10.sıradaki mesajıma girmişsiniz. Nasıl yaptınız anlayamadım. Ben de Kontrol Paneli'nden sizden cevap bekliyordum. devamlı güncellememe rağmen yeni mesaj gelmemişti. Cevabınızı tesadüfen gördüm)

 

[Ergün Güler]

Selam,
12.sıraki mesajımı güncelledim.

 

[Orion1]

Selam Sayın Gizlen,
Çok teşekkür ederim. Dediğiniz gibi metin aradım bulmadım. Sayılar fonksiyonlar sonucu geldiğinden zannettim. O da değilmiş. Problem aşağıdaki koddaki kırmızı lanadan kaynaklanıyormuş. Sayfa aktif olduğunda combobox'lara liste harici bir de ben boş eklemiştim. bunları iptal edince sorun düzeldi.
Ellerinize sağlık sirala_sayi(liste) fonksiyonu da tam istediğim gibi çalışıyor.
tam istediğim gibi.
Sizlere ne kadar çok teşekkür azdır.

Private Sub Worksheet_Activate()
Call sorguyeri
Dim liste

operator.Clear
insort.Clear
format.Clear
ebat.Clear
Sayfa.Clear
Yaprak.Clear
gsm.Clear

insort.AddItem ""
ebat.AddItem ""
[B][COLOR="Red"]'Sayfa.AddItem ""
'Yaprak.AddItem ""
'gsm.AddItem ""[/COLOR][/B]

insort ve ebat'taki gibi Sayfa,Yaprak ve gsm comboboxları içinde, en başta bir tane boş nasıl verebilirim?
Not: Birşey soracağım siz benim 10.sıradaki mesajıma girmişsiniz. Nasıl yaptınız anlayamadım. Ben de Kontrol Paneli'nden sizden cevap bekliyordum. devamlı güncellememe rağmen yeni mesaj gelmemişti. Cevabınızı tesadüfen gördüm)

Sanırım alıntı yapma yerine düzeltme butonuna basmışım.
Bizde düzeltme için buton gözüküyor.Yetkili olduğumuz için sizde yok o buton.
Oradan girip istediğimize düğzeletme yapabiliyoruz
O iki buton yanyana duroyor ben alıntı butonu yerine düzeltme butonuna basmışım.Ondan olmuş sildim girip tekkraradan.
Kolay gelsin.

 

[Orion1]

insort.AddItem ""
ebat.AddItem ""
'Sayfa.AddItem ""
'Yaprak.AddItem ""
'gsm.AddItem ""[/CODE]

insort ve ebat'taki gibi Sayfa,Yaprak ve gsm comboboxları içinde, en başta bir tane boş nasıl verebilirim?

Siz vermişsiniz zaten.

 

[Orion1]

eğer comboboxa ilk değeri boşluk olarak alıyorsanız ve sayısal değer sıralama yapmak istoyorsanız,ve ilk değerin boşluk olmasını istiyorsanız,o zaman fonksiyonda döngüye sıfırdan değilde 1 den başlamalısınız.O zman onu dikkate almaz.ilk sırada boşluk olabilir.hatada vermez.
Aşağıdaki kormızı renkle yaptığım yeri değiştirin.

Public Function sirala_sayi(liste)
Dim i As Long, j As Long, x
For i = [B][COLOR="Red"]LBound(liste)+1[/COLOR][/B] To UBound(liste) - 1
    For j = i + 1 To UBound(liste)
        If CDbl(liste(i, 0)) > CDbl(liste(j, 0)) Then
            x = liste(i, 0)
            liste(i, 0) = liste(j, 0)
            liste(j, 0) = x
        End If
    Next j
Next i
sirala_sayi = liste
End Function

 

[Ergün Güler]

Siz vermişsiniz zaten.

Selam,
Dikkat ederseniz başında ' (tırnak işareti) var. Yani aktif etmedim.Sorun zaten bundan kaynaklanıyordu sayfa.addıtem "" dersem Sayfadaki sayıları sirala_sayi(liste) ile hata veriyordu. bu kısmı iptal edince sorun düzeldi.

istediğim şu idi
combobox'un ilk satırına daha farklı nasıl boşluk verebiliriz. Çünkü, ilgili combobox'u sorgu harici tutmak için "" şeçmem veya el ile silmem gerekiyor.

İyi çalışmalar.

 

[Orion1]

Selam,
Dikkat ederseniz başında ' (tırnak işareti) var. Yani aktif etmedim.Sorun zaten bundan kaynaklanıyordu sayfa.addıtem "" dersem Sayfadaki sayıları sirala_sayi(liste) ile hata veriyordu. bu kısmı iptal edince sorun düzeldi.

istediğim şu idi
combobox'un ilk satırına daha farklı nasıl boşluk verebiliriz. Çünkü, ilgili combobox'u sorgu harici tutmak için "" şeçmem veya el ile silmem gerekiyor.

İyi çalışmalar.

Yanıtı 16ncı mesajda vermiştim.

 

[Ergün Güler]

eğer comboboxa ilk değeri boşluk olarak alıyorsanız ve sayısal değer sıralama yapmak istoyorsanız,ve ilk değerin boşluk olmasını istiyorsanız,o zaman fonksiyonda döngüye sıfırdan değilde 1 den başlamalısınız.O zman onu dikkate almaz.ilk sırada boşluk olabilir.hatada vermez.
Aşağıdaki kormızı renkle yaptığım yeri değiştirin.

Public Function sirala_sayi(liste)
Dim i As Long, j As Long, x
For i = [B][COLOR="Red"]LBound(liste)+1[/COLOR][/B] To UBound(liste) - 1
    For j = i + 1 To UBound(liste)
        If CDbl(liste(i, 0)) > CDbl(liste(j, 0)) Then
            x = liste(i, 0)
            liste(i, 0) = liste(j, 0)
            liste(j, 0) = x
        End If
    Next j
Next i
sirala_sayi = liste
End Function

Sayın Evren Gizlen,
Kusura bakmayınız. Ben size yazarken siz bana cevap göndermişsiniz. gönderdikten sonra ancak görebildim.
Dediğiniz değişikliği yaptım. boşluk vermediği gibi, sayıları eskisi gibi karışık sırlamaya başladı. bende değişikilği geri aldım.
İyi çalışmalar.

 

[Orion1]

Sayın Evren Gizlen,
Kusura bakmayınız. Ben size yazarken siz bana cevap göndermişsiniz. gönderdikten sonra ancak görebildim.
Dediğiniz değişikliği yaptım. boşluk vermediği gibi, sayıları eskisi gibi karışık sırlamaya başladı. bende değişikilği geri aldım.
İyi çalışmalar.

Acaba ben yapınca niye sıaralama doğru oluyor ve ilk sırada boşluk olabiliyor?
Ekli dosyayı inceleyiniz.