Aynı satırda aynı değerlere sahip diğer hücreleri silme

[hopeful]

merhaba
Aynı satırda yer alan aynı değere sahip diğer hücreleri nasıl silebiliriz.

Örn :
4,2,3,5,4,3,6,7,3,9 veriliyor.. 4 ve 3 ten birden fazla var

sonuç : 4,2,3,5, , ,6,7, ,9
4,2,3,5,6,7,9

 

[Levent Menteşoğlu]

Aşağıdaki kodu deneyin.

Sub sil()
For a = Cells(5, 256).End(xlToLeft).Column To 3 Step -1
say = WorksheetFunction.CountIf(Rows(5), Cells(5, a))
If say > 1 Then Columns(a).Delete
Next
End Sub

 

[Ali]

Alternatif
Bir modüle aşağıdaki kodları ekleyin.

Function Benzersiz(Aralik As Range, i As Integer)
Application.Volatile
Dim ciftolmayan As New Collection
For Each ce In Aralik
On Error Resume Next
ciftolmayan.Add ce, CStr(ce)
Next ce
If i > ciftolmayan.Count Then
Benzersiz = ""
Else
Benzersiz = ciftolmayan(i)
End If
End Function

C12 hücrenizede

=Benzersiz($C$5:$L$5;SÜTUN()-2) yazıp sağa doğru çekin.

 

[hopeful]

Alternatif
Bir modüle aşağıdaki kodları ekleyin.

Function Benzersiz(Aralik As Range, i As Integer)
Application.Volatile
Dim ciftolmayan As New Collection
For Each ce In Aralik
On Error Resume Next
ciftolmayan.Add ce, CStr(ce)
Next ce
If i > ciftolmayan.Count Then
Benzersiz = ""
Else
Benzersiz = ciftolmayan(i)
End If
End Function

C12 hücrenizede

=Benzersiz($C$5:$L$5;SÜTUN()-2) yazıp sağa doğru çekin.

sayın fructose
yazdıklarınızı yaptım. aNcak C12 ve diğer sürekliğim hücrelerde #VALUE! hatası verdi..

 

[hopeful]

Aşağıdaki kodu deneyin.

Sub sil()
For a = Cells(5, 256).End(xlToLeft).Column To 3 Step -1
say = WorksheetFunction.CountIf(Rows(5), Cells(5, a))
If say > 1 Then Columns(a).Delete
Next
End Sub

sayın leventm
yazmış olduğunuz kod doğru sonuç veriyor. ancak alt alta yer alan birden fazla satır için (örneğin 5. ile 300. satır arasını verilerle dolduracağım) bu işlemi yaptırdığımda silinmemesi gereken veriler siliniyor (sütun silindiği için).Yazmış olduğunuz kodu belli geniş bir satır aralığı için ( 5 ile 500 arası)olacak şekilde düzenleyebilir misiniz..Ekteki dosyayı güncelledim...

 

[Levent Menteşoğlu]

Aşağıdaki kodu deneyin.

Sub sil()
Application.ScreenUpdating = False
For b = 5 To [c65536].End(3).Row
For a = Cells(b, 256).End(xlToLeft).Column To 3 Step -1
say = WorksheetFunction.CountIf(Rows(b), Cells(b, a))
If say > 1 Then Cells(b, a).Delete Shift:=xlToLeft
Next
Next
End Sub

 

[Ali]

Bende denedim hata vermiyor. Örneğiniz ekte.

Sarı alandaki veriler sizin istediğiniz verilerdir.

 

[hopeful]

Aşağıdaki kodu deneyin.

Sub sil()
Application.ScreenUpdating = False
For b = 5 To [c65536].End(3).Row
For a = Cells(b, 256).End(xlToLeft).Column To 3 Step -1
say = WorksheetFunction.CountIf(Rows(b), Cells(b, a))
If say > 1 Then Cells(b, a).Delete Shift:=xlToLeft
Next
Next
End Sub

ellerine sağlık sayın leventm. çok teşekkür ederim

 

[hopeful]

Bende denedim hata vermiyor. Örneğiniz ekte.

Sarı alandaki veriler sizin istediğiniz verilerdir.

çok teşekkür ediyorum sayın fruktose.ellerinize sağlık