ComBobox'a gelen aynı isimleri teke indirmek

[İsmail Küçükşengün]

Merhabalar;

Combobox'a, sayfadan isimler gelmekte.

Aynı kişiye ait birden fazla veri varsa, hepsi birlikte gelmekte.
Mesela Ali Velioğlu kişiye ait 3-5 satırda bilgi varsa, 3-5 adet Ali Velioğlu ismi gelmekte.

Combo'ya gelen aynı isimler (birden fazla satır olsa bile) Combo'ya tek isim olarak nasıl getirebiliriz.

Şimdiden Teşekkürlerimle.

 

[Ali]

Private Sub UserForm_Initialize()
Dim AllCells As Range, Cell As Range
Dim ciftolmayan As New Collection
Dim Item
' A1:A105 arası öğeleri yükler
Set AllCells = Range("A1:A105")
On Error Resume Next
For Each Cell In AllCells
ciftolmayan.Add Cell.Value, CStr(Cell.Value)
Next Cell
On Error GoTo 0
' Benzersiz öğeleri Combobox'a ekler
For Each Item In ciftolmayan
UserForm1.ComboBox1.AddItem Item
Next Item
UserForm1.Show
End Sub

 

[Mahmut Bayram]

Uygulamalı örnek bir dosya.

 

[İsmail Küçükşengün]

Sayın Ali;

İlgine teşekkür ederim. Verdiğiniz kodu çalışmama uyguladım.

Private Sub UserForm_Initialize()
Sheets("hesaplar").Select
Dim AllCells As Range, Cell As Range
Dim ciftolmayan As New Collection
Dim Item
' A1:A105 arası öğeleri yükler
Set AllCells = Range("C2:C2000")
On Error Resume Next
For Each Cell In AllCells
ciftolmayan.Add Cell.Value, CStr(Cell.Value)
Next Cell
On Error GoTo 0
' Benzersiz öğeleri Combobox'a ekler
For Each Item In ciftolmayan
UserForm28.ComboBox1.AddItem Item
Next Item
UserForm28.Show
ListBox1.ColumnCount = 7
ListBox1.ColumnHeads = True
ListBox1.ColumnWidths = "90;60;60;120;120;60;60"
End Sub

Fakat bu sefer ilgili form açılmamakta
"Permision denied" hatası vermektedir.

Yazdığım kodda ne gibi değişiklik gerekir.

Teşekkürler.

 

[İsmail Küçükşengün]

Sayın Partner;

Örnek dosya gözükmüyor.

 

[Mahmut Bayram]

Dosya bende gözüküyor.
Ama sizin dosya gözükmüyor.
Şaka şaka :mrgreen:
Örnek bir dosya eklemeniz mümkün mü?

 

[İsmail Küçükşengün]

Sayın Partner;

Veri alacağım sayfa adı "hesaplar".
Buna göre verdiğiniz örnekteki kodu;
Private Sub UserForm_Initialize()
Sheets("hesaplar").Select
For X = 2 To Cells(65536, 1).End(xlUp).Row
If WorksheetFunction.CountIf(Range("c3:c" & X), Cells(X, 1)) = 1 Then
ComboBox1.AddItem Cells(X, 1).Value
End If
Next


ListBox1.ColumnCount = 7
ListBox1.ColumnHeads = True
ListBox1.ColumnWidths = "90;60;60;120;120;60;60"
End Sub

şeklinde uyguladım.

Bu kez hiç veri gelmedi.

 

[Mahmut Bayram]

Sayın Partner;

Veri alacağım sayfa adı "hesaplar".
Buna göre verdiğiniz örnekteki kodu;
Private Sub UserForm_Initialize()
Sheets("hesaplar").Select
For X = 2 To Cells(65536, 1).End(xlUp).Row
If WorksheetFunction.CountIf(Range("c3:c" & X), Cells(X, 1)) = 1 Then
ComboBox1.AddItem Cells(X, 1).Value
End If
Next


ListBox1.ColumnCount = 7
ListBox1.ColumnHeads = True
ListBox1.ColumnWidths = "90;60;60;120;120;60;60"
End Sub

şeklinde uyguladım.

Bu kez hiç veri gelmedi.

Sayın kucuksengun;
Yukarıdaki kodlarda Listbox ve comboboxla ilgili kodlar var.
Sizin userformda Listbox olduğundan emin misiniz?

 

[Ali]

For X = 2 To Cells(65536, 1).End(xlUp).Row

ilgili kısım hatalı A sütundaki değere göre döngü kuruluyor.

If WorksheetFunction.CountIf(Range("c3:c" & X), Cells(X, 1)) = 1 Then

ile C sütunu saydırılıyor. Dosyanızda nasıl bilemediğim ilgili kısımı şu şekilde değiştirin.

For X = 2 To Cells(65536, 3).End(xlUp).Row

 

[İsmail Küçükşengün]

Sayın Ali;

Combobox'a getirilecek bilgiler (isimler) "hesaplar" adlı sayfanın C sütununda.
Buna göre yukarıdaki önerinizi yerine getirdiğim halde, bu sefer Combo'ya hiç veri gelmedi.

 

[İsmail Küçükşengün]

Sayın Partner;

Evet. Userfomda ayrıca Listbox. da var.
Combobox'a getirilecek bilgiler (isimler) "hesaplar" adlı sayfanın C sütununda.

 

[programer]

Sayın Partner;

Evet. Userfomda ayrıca Listbox. da var.
Combobox'a getirilecek bilgiler (isimler) "hesaplar" adlı sayfanın C sütununda.

userforma aşağıdaki kodu yapıştırıp denermisiniz

Private Sub UserForm_Initialize()
sonsatır = Worksheets("hesaplar").Range("C65536").End(xlUp).Row
If sonsat&#305;r < 3 Then sonsat&#305;r = 3
ComboBox1.RowSource = "hesaplar!c2:c" & sonsat&#305;r
End Sub

 

[İsmail Küçükşengün]

Say&#305;n Programer;

Verdi&#287;iniz kodu uygulad&#305;m.

Ayn&#305; isimler (ne kadar varsa) hepsi &#231;&#305;k&#305;yor.
Oysa ayn&#305; isimden birden fazla varsa, yaln&#305;zca bir kez &#231;&#305;kmas&#305; gerekli.

 

[Ali]

Kodlar&#305;n&#305;z&#305; Exit Sub i&#231;eren bir sat&#305;rdan sonram&#305; kullan&#305;yorsunuz.Yada herhangi bir &#351;ekilde GoTo ile ba&#351;ka bir k&#305;s&#305;mam&#305; gidiliyor onu inceleyin.&#214;rnek dosya &#252;zerinden gitmek daha iyi olur.

 

[Merhum İdris SERDAR]

Sayın Programer;

Verdiğiniz kodu uyguladım.

Aynı isimler (ne kadar varsa) hepsi çıkıyor.
Oysa aynı isimden birden fazla varsa, yalnızca bir kez çıkması gerekli.

Aşağıdaki örnek dosyayı inceleyin.

 

[Haluk]

Dosya: http://www.excel.web.tr/attachment.php?attachmentid=5687&d=1162898324

Mesaj : http://www.excel.web.tr/showthread.php?t=11589

 

[İsmail Küçükşengün]

Sayın: Haluk, yurttaş, ali, programer, partner;

İlginize çok teşekkür ederim.

İşte bu sitenin farkı bu. Paylaşımcılık, yardım, ilgi, ...vs...
Bundan dolayı, herkesin doğru adreste olduğunu bir kez bilmesi gerekiyor.

Fakat bu kadar örneklere rağmen sorunumu yine de halledemedim.

Dosyamdan bir örnek hazırlayıp ekte sunuyorum.

Tekrar teşekkürlerimi sunuyorum.

 

[Levent Menteşoğlu]

Userformdaki kodu aşağıdaki ile değiştirin. Yalnız combobox1 in rowsource özelliğine yazdığınız aralığı silin.

Private Sub UserForm_Initialize()
Set s1 = Sheets("hesaplar")
For a = 2 To s1.[c65536].End(3).Row
If WorksheetFunction.CountIf(s1.Range("c2:c5" & a), s1.Cells(a, "c")) = 1 Then ComboBox1.AddItem s1.Cells(a, "c")
Next
ListBox1.ColumnCount = 7
ListBox1.ColumnHeads = True
ListBox1.ColumnWidths = "90;60;60;120;120;60;60"
End Sub

 

[Mahmut Bayram]

Sayın kucuksengun
Dosyanıza uygulanmış örneği ekte.

 

[İsmail Küçükşengün]

Say&#305;n leventm;

Dedi&#287;iniz aynen yapt&#305;m. Fakat bu kez hi&#231; veri gelmedi.

Say&#305;n Partner;

Tam istedi&#287;im gibi olmu&#351;.
Te&#351;ekk&#252;r eder, hay&#305;rl&#305; vazifeler dilerim.