benzer satırların silinmesi

[japoncaci]

merhaba elimdeki listede A, B ve C stunlarındaki veri aynıysa o satırın silinmesini istiyorum. eğer mümkünse altındakiler silinsin

siteyi araştırdım A stunundakiler aynıysa silen kod var.

teşekkürler.

 

[İhsan Tank]

merhaba elimdeki listede A, B ve C stunlarındaki veri aynıysa o satırın silinmesini istiyorum. eğer mümkünse altındakiler silinsin

siteyi araştırdım A stunundakiler aynıysa silen kod var.

teşekkürler.

merhaba
boş bir module kopyalayarak deneyiniz

Option Explicit
Sub sil()
Dim ts, kaplan
kaplan = MsgBox("A B C sütunlarında Aynı Olan Veriler'i Siliyorum", _
vbYesNo, "Onay")
If kaplan = vbNo Then Exit Sub
For ts = Cells(65536, "A").End(xlUp).Row To 1 Step -1
If Cells(ts, "A") = Cells(ts, "B") And _
Cells(ts, "A") = Cells(ts, "C") And _
Cells(ts, "B") = Cells(ts, "C") Then
Range("A" & ts & ":E" & ts).Delete
End If
Next
MsgBox "Eşit Olan Verileri Sildim", vbInformation, "Bitiş"
End Sub

dosyayı kaydetmek için lütfen makro içerebilen dosya şeklinde kayıt yapınız uzantısı .xlsm olmalı

 

[japoncaci]

teşekkürler ihsan. verdiğin kod çalıştı ama, ben sorunumu doğru açıklayamadığım için haliyle kod da doğru çalışmadı. özürdilerim.
bu bi sözlük olucak.
mesala 4. 5. ve 6. satırda a,b ve c stunları aynı. 5. ve 6 satırın silinmesini, 4. satırın kalmasını istiyorum.

yanibir satırdaki a,b,c stunundaki hücre , başka bir satırdaki a,b,c stunundaki hücreyle aynıysa bir satır kalsın diğerleri silinsin.

umarım açıklaya bilmişimdir. vaktini çaldığım için tekrar özür dilerim.

 

[İhsan Tank]

teşekkürler ihsan. verdiğin kod çalıştı ama, ben sorunumu doğru açıklayamadığım için haliyle kod da doğru çalışmadı. özürdilerim.
bu bi sözlük olucak.
mesala 4. 5. ve 6. satırda a,b ve c stunları aynı. 5. ve 6 satırın silinmesini, 4. satırın kalmasını istiyorum.

yanibir satırdaki a,b,c stunundaki hücre , başka bir satırdaki a,b,c stunundaki hücreyle aynıysa bir satır kalsın diğerleri silinsin.

umarım açıklaya bilmişimdir. vaktini çaldığım için tekrar özür dilerim.

merhaba
kodu bununla değiştirir misiniz

Option Explicit
Sub sil()
Dim ts, kaplan
kaplan = MsgBox("Mükerrer Verileri Siliyorum", vbYesNo, "Onay")
If kaplan = vbNo Then Exit Sub
For ts = 1 To Cells(65536, "A").End(xlUp).Row
Cells(ts, "F") = Cells(ts, "A") & Cells(ts, "B") & _
Cells(ts, "C")
Next
For ts = Cells(65536, "F").End(xlUp).Row To 1 Step -1
If WorksheetFunction.CountIf(Range("F1:F" & ts), _
Cells(ts, "F")) > 1 Then
Range("A" & ts & ":F" & ts).Delete
End If
Next
Range("F:F").ClearContents
MsgBox "Mükerrer Verileri Sildim", vbInformation, "Bitiş"
End Sub

 

[Ömer]

mesala 4. 5. ve 6. satırda a,b ve c stunları aynı. 5. ve 6 satırın silinmesini, 4. satırın kalmasını istiyorum.

Merhaba,

Alternatif olsun.

Sub BenzersizleriListele()
 
    Dim deg As String, i As Long, j As Long, x As Integer
    Dim dizi() As String, d As Object
 
    Application.ScreenUpdating = False
 
    Set d = CreateObject("Scripting.Dictionary")
 
    For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
        deg = Cells(i, "A") & "|" & Cells(i, "B") & "|" & Cells(i, "C")
        If Not d.exists(deg) Then
            j = j + 1
            ReDim Preserve dizi(1 To 5, 1 To j)
                For x = 1 To 5
                    dizi(x, j) = Cells(i, x)
                Next x
            d.Add deg, Nothing
        End If
    Next i
 
    Range("A1:E" & i).ClearContents
    Range("A1").Resize(j, 5) = WorksheetFunction.Transpose(dizi)
 
    Application.ScreenUpdating = True
 
End Sub

.

 

[japoncaci]

teşekkürler iki komutta işime yaradı.

 

[İhsan Tank]

teşekkürler iki komutta işime yaradı.

rica ederim
:yazici: