Döngü mantığı

[idogus]

Birden fazla sayıda aynı değeri olan kayıtları tek kalana kadar çalışacak döngü en basit şekilde nasıl kurulabilir ? örn: Combobox'a liste alacaksınız sütünda bir birinin aynı olan değerlerden farklı olanları istiyorsunuz?

 

[Haluk]

Bu iş için çeşitli mantıkta döngüler hazırlanabilir.

Bunlardan bir tanesi;

[vb:1:727ebf241a]Sub FrmAc()
Dim NoA As Long
Dim MyColl As New Collection
Dim i As Long, j As Long
Set Sh = Sheets("Sayfa1")
NoA = Sh.Range("A65536").End(xlUp).Row
For i = 1 To NoA
MyColl.Add Sh.Cells(i, 1)
Next
For i = MyColl.Count - 1 To 1 Step -1
For j = MyColl.Count To i + 1 Step -1
If MyColl(i) = MyColl(j) Then
MyColl.Remove j
End If
Next
Next
For i = 1 To MyColl.Count
UserForm1.cmbLst.AddItem MyColl(i)
Next
UserForm1.Show
End Sub
[/vb:1:727ebf241a]

 

[Haluk]

Döngü kullanmadan bir çözüm yolu ise, aşağıdaki gibi olabilir...

[vb:1:d92103eae4]Sub FrmAc()
Dim NoA As Long, NoAA As Long
Set sh = Sheets("Sayfa1")
NoA = sh.Range("A65536").End(xlUp).Row
NoAA = sh.Range("AA65536").End(xlUp).Row
sh.Range("AA1:AA" & NoAA).Clear
sh.Range("A1:A" & NoA).AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=sh.Range("AA1"), Unique:=True
UserForm1.cmbLst.RowSource = "Sayfa1!AA2:AA" & NoAA
UserForm1.Show
End Sub
[/vb:1:d92103eae4]

 

[idogus]

Sn. Raider
Çok teşekkür ederim

 

[Levent Menteşoğlu]

Mükerrer kayıtların elenmesi ile ilgili benimde bir kod düşüncem vardı. Bununla ilgili başta sn Raider olmak üzere yorumlarınızı rica ediyorum.

[vb:1:4819da0d2a]Sub FrmAc()
For a = 1 To Cells(65536, 1).End(xlUp).Row
If WorksheetFunction.CountIf(Range("A1:A" & a), Cells(a, 1).Value) = 1 Then
UserForm1.cmbLst.AddItem Cells(a, 1).Value
End If
Next a
UserForm1.Show
End Sub
[/vb:1:4819da0d2a]

 

[ALPEN]

Gerçekten çok zekice Sn. leventm tebrik ederim.

 

[Haluk]

yorumlarınızı rica ediyorum.

Bence gayet guzel olmus, ne de olsa Excel'in kendine has fonksiyonları kullanmak işin çok daha rahat yapılabilmesini sagliyor.

Excel VBA'de benzersiz - ayıklanmış liste elde etmekle ilgili olarak, gördüğüm en pratik çözüm olduğunu söyleyebilirim. Lütfen tebriklerimi kabul et leventm arkadaşım.

 

[Levent Menteşoğlu]

Sn ALPEN, Sn Raider sizin gibi çok değerli üstatlarımızdan bu yorumları duymak bana onur verdi. Başta sizler olmak üzere tüm diğer arkadaşlardan öğrendiklerimi geliştirerek ve pratikleştirerek tekrar forumda paylaşmak benim en büyük hobim oldu artık. Bilgi dağarcığım sizler sayesinde her geçen gün daha da gelişiyor, eminim diğer arkadaşlarda benimle aynı fikirdedir. Bizlere yapmış olduğunuz tüm katkılarınız nedeniyle sizlere bir kez daha teşekkür ediyorum.

 

[alpay1]

Eğer izin verirseniz bende bu değerli çalışmanızla ilgili bir soru sormak istiyorum.
Sayın leventm,
Bu kodlarla listelemeyi herhangi bir sütunda nasıl yapabiliriz?Aynı sayfa yada başka bir sayfanın sütunuda.

 

[Levent Menteşoğlu]

Kodu aşağıdaki gibi düzenleyebilirsiniz. Burada kodun ana listenin olduğu sayfadan(ör. sayfa1 den-buton sayfa1de olacak) veri aldığını düşünürsek, listeleme sayfa2 nin A sütununa yapılacaktır.

[vb:1:e2c6ef9967]Sub listele()
For a = 1 To Cells(65536, 1).End(xlUp).Row
If WorksheetFunction.CountIf(Range("A1:A" & a), Cells(a, 1).Value) = 1 Then
c=c+1
sheets("sayfa2").cells(c,1)=cells(a,1).value
End If
Next a
End Sub
[/vb:1:e2c6ef9967]

Ektede bir örnek dosya sunuyorum.

 

[alpay1]

Çok teşekkür ederim sayın leventm.
İyi çalışmalar.

 

[idogus]

Sn ALPEN, Sn Raider sizin gibi çok değerli üstatlarımızdan bu yorumları duymak bana onur verdi.

Bizlere yapmış olduğunuz tüm katkılarınız nedeniyle sizlere bir kez daha teşekkür ediyorum.

Sayın leventm,
Ne kadar da şanslısın. Sen sadece Sn.Raider ve Sn.Alpen'e teşekkür etmekle işi kurtarıyorsun.
Ya ben ne yapacam ben hepinize birden teşekkür etmek zorundayım
Sorduğum bir soruyla anında hepiniz bir tartışma ortamına girdiniz ve öğrenmek isteğimizden fazlasını öğrenmemize sebep oldunuz . Hepinize Teşekkürler :arkadas: