Yatay tekrarlanan değerleri kaldırma

[heartspasm]

Merhabalar,

Ekteki gibi bir dosyadan yatay olarak tekarlanan değerleri silen bir vba koduna ihtiyacım var.Yardımcı olabilir misiniz?

 

[turist]

Deneyin.

Sub TekrarSil()
 Dim sonsatır As Long
    With ActiveSheet
        sonsatır = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With
Dim sonsütun As Long
   With ActiveSheet.UsedRange
        sonsütun = .Columns(.Columns.Count).Column
    End With
    Application.ScreenUpdating = False
 Dim sonsilsatır As Long
For i = 2 To sonsatır
    Range(Cells(i, 2), Cells(i, sonsütun)).Select
    Selection.Copy
    Cells(1, sonsütun + 1).Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Application.CutCopyMode = False
    With ActiveSheet
        sonsilsatır = .Cells(.Rows.Count, sonsütun + 1).End(xlUp).Row
    End With
    ActiveSheet.Range(Cells(1, sonsütun + 1), Cells(sonsilsatır, sonsütun + 1)).RemoveDuplicates Columns:=1, Header:=xlNo
    Range(Cells(i, 2), Cells(i, sonsütun)).Select
    Selection.ClearContents
    Range(Cells(1, sonsütun + 1), Cells(sonsilsatır, sonsütun + 1)).Select
    Selection.Copy
    Cells(i, 2).Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Application.CutCopyMode = False
    Range(Cells(1, sonsütun + 1), Cells(sonsilsatır, sonsütun + 1)).Select
    Selection.ClearContents
    Next i
    Range("B1").Select
    Application.ScreenUpdating = True
End Sub

 

[Ömer BARAN]

Merhaba.

Alternatif olsun.
-- Sadece hücre içeriklerini silmek için (bu durumda içeriği silinen hücreler boş kalır) mavi olan satırı kullanın, kırmızıyı silin,
-- Hücreleri silmek için (böylece tekrarsız ve boşluksuz olarak sola yanaşık liste oluşur) kırmızı olan satırı kullanın, maviyi silin.
.

[FONT="Arial Narrow"][B]Sub MÜKERRER_SİL()[/B]
For satır = 2 To Cells(1, 1).SpecialCells(xlCellTypeLastCell).Row
    For sütun = Cells(1, 1).SpecialCells(xlCellTypeLastCell).Column To 1 Step -1
    If Cells(satır, sütun) = "" Or _
        WorksheetFunction.CountIf(Range(Cells(satır, 1), _
        Cells(satır, sütun)), Cells(satır, sütun)) = 1 Then GoTo 10
[COLOR="Blue"][B]        Cells(satır, sütun).ClearContents[/B][/COLOR]
[B][COLOR="Red"]        Cells(satır, sütun).Delete Shift:=xlToLeft[/COLOR][/B]
10: Next: Next
[B]End Sub[/B][/FONT]

 

[heartspasm]

Teşekkürler arkadaşlar ellerinize sağlık ikisi de çalışıyor