Farklı isimlerin listelenmesi.

[mrs303]

Selam Arkadaşlar,
Problemi formül ile çözmeye çalıştım fakat çok ağır kaldı ve tam istediğim gibi olmadı malesef.

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

mesajda Sn, Ömer bey formül ile çözümledi fakat uyarıları üzerine gerçektende büyük listelerde çok ağır kaldı ve oldukca yavaşladı PC. Ömer bey'in önerisi üzerine çözümü Makro ile aramaya karar verdim. Bu konuda yardımcı olabilirseniz sevinirim.
Saygılar.....


Ekteki dosyada H sütununda yaptığım formülde bir hata var

= EĞER(G3="";"";EĞER(EĞERSAY($C$2:C3;C3)<>1;"";TOPLA .ÇARPIM(--(C3>$C$3:$C$2513))+TOPLA.ÇARPIM(--($C$3:C3:C3=C3))))

formül başlangıç haftasını 1 olarak seçince çalışıyor fakat başka bir değer seçince çalışmıyor.

 

[Orion1]

Dosyanız ektedir.

Sub benzersiz_listele_59()
Dim sat As Long, conn As Object, rs As Object, i As Long
Sheets("Sayfa1").Select
Range("E4:G65536").ClearContents
sat = Cells(65536, "A").End(xlUp).Row
If sat < 3 Then Exit Sub
Set conn = CreateObject("AdoDb.Connection")
Set rs = CreateObject("AdoDb.Recordset")
conn.Open "Provider=Microsoft.jet.oledb.4.0;data source=" & _
ThisWorkbook.FullName & ";Extended properties=""Excel 8.0;hdr=no;imex=1"";"
rs.Open "select first(F2),F3 from [Sayfa1$A3:C65536] where F1 >= " & _
Range("G1").Value & " and F1 <= " & Range("G2").Value & " Group by F3", conn, 1, 1
If rs.RecordCount > 0 Then
    Application.ScreenUpdating = False
    Range("F4").CopyFromRecordset rs
    For i = 1 To rs.RecordCount
        Cells(i + 3, "E").Value = i
    Next i
    Application.ScreenUpdating = True
    MsgBox "İşlem Tamamlandı.", vbOKOnly + vbInformation, "İŞLEM BİTTİ"
End If
Application.ScreenUpdating = True
rs.Close: conn.Close
Set rs = Nothing: Set conn = Nothing
End Sub

 

[mrs303]

Sn Evren Bey,

Kodu çalıştırınca 1 sn de işlem tamam dedi, inanılmaz hızlı olmuş. Formülle 15 dk. sürüyordu bu işlemler. Sanırım artık Makro işine el atma zamanım geldi.

Fakat Kodda küçük bir eksiklik var, veya ben tam anlatamamış olabilirim. Şöyle ki ;

Hafta aralığı seçildiğinde G sütunundaki isimlerin tamamen benzersiz olması gerekiyor.
Baş. Haftası 2 - Bitiş Haftası 4 seçtiğimizde Ahmet Felek hem 2. hafta hem 3. hafta hemde 4. haftada görünüyor. İsteğim sadece 1 tane ahmet felek olması. E sütununda Hafta numarası yazmasına gerek yok, hafta numarası yerine benzersiz her kayda herhangi bir sayı ataması. dosyada gerekli açıklamayı yaptım , düzeltebilirseniz çok sevinirim. Teşekkürler.

 

[Orion1]

Sn Evren Bey,

Kodu çalıştırınca 1 sn de işlem tamam dedi, inanılmaz hızlı olmuş. Formülle 15 dk. sürüyordu bu işlemler. Sanırım artık Makro işine el atma zamanım geldi.

Fakat Kodda küçük bir eksiklik var, veya ben tam anlatamamış olabilirim. Şöyle ki ;

Hafta aralığı seçildiğinde G sütunundaki isimlerin tamamen benzersiz olması gerekiyor.
Baş. Haftası 2 - Bitiş Haftası 4 seçtiğimizde Ahmet Felek hem 2. hafta hem 3. hafta hemde 4. haftada görünüyor. İsteğim sadece 1 tane ahmet felek olması. E sütununda Hafta numarası yazmasına gerek yok, hafta numarası yerine benzersiz her kayda herhangi bir sayı ataması. dosyada gerekli açıklamayı yaptım , düzeltebilirseniz çok sevinirim. Teşekkürler.

Önceki mesajımda dosyayı güncelledim.Bir deneyein bakalım olmuşmu?

 

[mrs303]

Çok güzel olmuş, Pazar günü bile mesaisine devam eden Excel.Web.tr ailesine ve size çok çok teşekkür ederim.

Yanlız hafta kısmı boş kallıyor, orada bir numara sırası olabilir mi acaba. 1 den başlayıp sıralama sonuna kadar. Olmasada çok önemli değil.
Emeğinize ve ellerinize sağlık.Teşekkürler.

 

[Orion1]

Çok güzel olmuş, Pazar günü bile mesaisine devam eden Excel.Web.tr ailesine ve size çok çok teşekkür ederim.

Yanlız hafta kısmı boş kallıyor, orada bir numara sırası olabilir mi acaba. 1 den başlayıp sıralama sonuna kadar. Olmasada çok önemli değil.
Emeğinize ve ellerinize sağlık.Teşekkürler.

Dosyayı 2 numaralı mesajdan indirebilirsiniz.

 

[mrs303]

Çok teşekkürle Evren bey, tek kelimeyle harikasınız, mükemmel olmuş.
Emeğiniz ve ilginiz için tekrer teşekkürler.

 

[Orion1]

Çok teşekkürle Evren bey, tek kelimeyle harikasınız, mükemmel olmuş.
Emeğiniz ve ilginiz için tekrer teşekkürler.

Rica ederim.
İyi çalışmalar.