Dizi veya hücre içinde bulunan ve tekrarlanan sayıları tespit etme

[coamtasis]

Arkadaşlar merhaba

Bu benim ödevim. Örnek olarak {2,2,3,4,4,5,6,6,7,7,8,9} elimizde bu küme var ve ödevde benden bu sayıların hangilerini kullandığımı istiyor yani tekrar eden sayıları değil de küme olarak bu sayıları istiyor. (Cevabın 2,3,4,5,6,7,8,9 çıkması gerekiyor). Umarım anlatabilmişimdir. İnanılmaz derecede uğraştım fakat bir sonuca ulaşamadım, yarına kadar yetiştirmem gerekli bunu. Çok teşekkürler şimdiden. Bu arada ödev Excel'in içindeki Visual Basic üzerinden olacak.

 

[Ömer]

Merhaba,

Verileri tekrarsız olarak mı istiyorsunuz.
Verileri hücrede mi.
Örneğin verileri A sütununda ise tekrarsız liste B sütununda mı listelenecek.

Soruyu daha detaylı açıklarmısınız.

 

[coamtasis]

Evet örnek olarak A sütununde 1,2,2,3,3,4,5 değerleri var ve ben B sütununa bunların tekrarsız halini yani sadece 1,2,3,4,5 değerlerini yazdırmak istiyorum kod ile. Çünkü sağ olsun hocamız kod halinde istiyor bir makro olarak

 

[Milady Meriç]

Merhaba,

Ekteki dosyayı inceler misiniz?

Makro kaydedicisinin istediğiniz işlem için yeterli olduğunu düşünüyorum aslında.

Kolay gelsin.

 

[coamtasis]

Merhaba,

Ekteki dosyayı inceler misiniz?

Makro kaydedicisinin istediğiniz işlem için yeterli olduğunu düşünüyorum aslında.

Kolay gelsin.

Çok teşekkür ederim aslında tam da işime yarayacak şey bu,fakat bu benim ödevim için fazla uzman işi olmuş,1-2 döngü kullanarak bu işlemi yapma şansımız yok mu acaba?

 

[Merhum İdris SERDAR]

.

Deneyin.

Sub Makro1()
sec = InputBox("Hangi sütuna kopyalansın? Bir harf yazın?")
    Range("A1:A100").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Cells(1, sec), Unique:=True
    Range("B1").Select
Cells(1, sec) = "Tekrarsız Liste"
End Sub

.

 

[coamtasis]

.

Deneyin.

Sub Makro1()
sec = InputBox("Hangi sütuna kopyalansın? Bir harf yazın?")
    Range("A1:A100").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Cells(1, sec), Unique:=True
    Range("B1").Select
Cells(1, sec) = "Tekrarsız Liste"
End Sub

.

Evet bu da işime yarıyor esasında, fakat yukarıda belirttiğim gibi bu benim ödevim için biraz uzman işi. Bunu 1-2 döngü içerisinde bir makro olarak bulma imkanımız yok mu acaba?

 

[Milady Meriç]

Benim gönderdiğim de ise yazılmış kod sadece 1 satır. Diğer hepsi makro kaydedicisi tarafından kayıt edildi.

Aslında Yurttaş Hocam oldukça basitleştirmiş. Sadece 100.satıra kadar baz alıp istediğiniz işlemi yapıyor.

 

[Milady Meriç]

Ayrıca Döngüden kastınız nedir?

Hocanız,illaki de For - Next döngüsü mü istiyor?

 

[coamtasis]

Evet aslında oldukça kullanışlı ve basit , çok teşekkür ederim ilginize. Bunu hocama göstereceğim . Peki bunun döngü şeklinde olanını yapma şansımız var mı? For döngüsünü kullanarak bir şeyler kurcaladım fakat bir sonuca ulaşamadım maalesef..

 

[coamtasis]

Ayrıca Döngüden kastınız nedir?

Hocanız,illaki de For - Next döngüsü mü istiyor?

For - Next olması şart değil ama genel olarak onu kullanıyoruz . While went hepsine açık

 

[Ömer]

Aslında en doğrusu Sayın yurttas'ın ve Sayın Milady Meriç'in önerdiği Excelin kendi içinde olan özelliğinin makrosudur.

Döngü ile istediğiniz için aşağıdaki gibi yazılabilir.

Sub Benzersiz()
 
    Dim d As Object, i As Long, deg, j
 
    Set d = CreateObject("Scripting.Dictionary")

    For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
        deg = Cells(i, "A")
        If Not d.exists(deg) Then
            d.Add deg, Nothing
        End If
    Next i
        
    j = d.keys
    Range("B1").Resize(d.Count, 1) = Application.Transpose(j)

End Sub

.

 

[coamtasis]

Aslında en doğrusu Sayın yurttas'ın ve Sayın Milady Meriç'in önerdiği Excelin kendi içinde olan özelliğinin makrosudur.

Döngü ile istediğiniz için aşağıdaki gibi yazılabilir.

Sub Benzersiz()
 
    Dim d As Object, i As Long, deg, j
 
    Set d = CreateObject("Scripting.Dictionary")

    For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
        deg = Cells(i, "A")
        If Not d.exists(deg) Then
            d.Add deg, Nothing
        End If
    Next i
        
    j = d.keys
    Range("B1").Resize(d.Count, 1) = Application.Transpose(j)

End Sub

.

Evet en işime yarar olan buydu. İlginize çok teşekkür ederim

 

[Milady Meriç]

Şahsi görüşüm hala yukarıda Sn. Yurttaş'ın örneğini yada benim göndermiş olduğum örneği kullanman yönünde ama For döngüsü ile basit birşey aşağıdaki gibi olabilir.

Sub Milady()

Dim a1 As Range
Set a1 = Range("B:B")

sat1 = Cells(Rows.Count, "A").End(xlUp).Row 'A sütnundaki dolu olan son hücreyi bulduk
ActiveSheet.Range("$B:$B").ClearContents ' B sütununda biþey varsa temizledik

For i = 1 To sat1
    
     x = Cells(i, 1).Value
     y = WorksheetFunction.CountIf(a1, x)
     If y = 0 Then
     sat2 = Cells(Rows.Count, "B").End(xlUp).Row
     Cells(sat2 + 1, 2).Value = x
     End If

Next
        
End Sub

 

[Milady Meriç]

Konu ikinci sayfaya taştığı için Ömer Bey'in çözümünü görmemişim, kusura bakmayın.

 

[coamtasis]

Şahsi görüşüm hala yukarıda Sn. Yurttaş'ın örneğini yada benim göndermiş olduğum örneği kullanman yönünde ama For döngüsü ile basit birşey aşağıdaki gibi olabilir.

Sub Milady()

Dim a1 As Range
Set a1 = Range("B:B")

sat1 = Cells(Rows.Count, "A").End(xlUp).Row 'A sütnundaki dolu olan son hücreyi bulduk
ActiveSheet.Range("$B:$B").ClearContents ' B sütununda biþey varsa temizledik

For i = 1 To sat1
    
     x = Cells(i, 1).Value
     y = WorksheetFunction.CountIf(a1, x)
     If y = 0 Then
     sat2 = Cells(Rows.Count, "B").End(xlUp).Row
     Cells(sat2 + 1, 2).Value = x
     End If

Next
        
End Sub

Bu da çok işime yaradı. Çok teşekkür ederim