tüm satırı aynı olan satırların silinmesi acil

[p_rens]

tüm hücreleri aynı olan satırları silmek

ekte ki örnek tabloda satırların sadece bir hücresine göre değilde tüm hücrelerin aynı olması durumunda ikinci satırı silen bir makroya ihtiyacım var.

acilen yardım ederseniz sevinirim.

 

[Orion1]

ekte ki örnek tabloda satırların sadece bir hücresine göre değilde tüm hücrelerin aynı olması durumunda ikinci satırı silen bir makroya ihtiyacım var.

acilen yardım ederseniz sevinirim.

Ekli dosyayı inceleyiniz.
B sütunu ile Ab sütunları arsında karşılaştırma yapar.
Gerçek dosya üzerinde denemeden önce dosyanızın bir yedeğini almanızı öneririm.Aksi takdirde sorumluluk kabul etmem.

Sub benzersiz()
Dim k As Byte, i As Long, j As Long
Dim z As Byte, hucredeg As String, dizideg As String
ReDim myarr(2 To 28, 1 To 1)
Application.ScreenUpdating = False
Set t = CreateObject("Scripting.Dictionary")
t.CompareMode = vbTextCompare
a = 1
For i = 2 To Cells(65536, "B").End(xlUp).Row
    hucredeg = ""
    For j = 2 To 28
        hucredeg = hucredeg & Cells(i, j).Value
    Next j
    '---------------------------------
    If Not t.exists(hucredeg) Then
       t.Add hucredeg, Nothing
        ReDim Preserve myarr(2 To 28, 1 To a)
        For z = 2 To 28
            myarr(z, a) = Cells(i, z).Value
        Next z
        a = a + 1
    End If
Next i
Range("B2:AB" & Cells(65536, "B").End(xlUp).Row).ClearContents
[B2].Resize(UBound(myarr, 2), 27) = Application.Transpose(myarr)
Application.ScreenUpdating = True
MsgBox "İşlem Tamam..!!"
End Sub

 

[hsayar]

evren hocam benimde aynı yönde bir sorum var fakat biraz içeriği farklı...

a:g arasındaki benzersiz satırlar tabloda kalsın ancak j:k aralığıda toplama aralığı olduğu için benzeriyle toplanarak silinsin bu mümkünmü?

 

[Korhan Ayhan]

Selamlar,

Alternatif olarak aşağıdaki koduda kullanabilirsiniz.

Sub MÜKERRER_OLANLARI_SİL()
    Application.ScreenUpdating = False
    [IV:IV].Clear
    With Range("IV2:IV" & [B65536].End(3).Row)
        .Formula = "=B2&C2&D2&E2&F2&G2&H2&I2&J2&K2&L2&M2&N2&O2&P2&Q2&R2&S2&T2&U2&V2&W2&X2&Y2&Z2&AA2&AB2"
        .Value = .Value
    End With
    For X = [IV65536].End(3).Row To 2 Step -1
    If WorksheetFunction.CountIf(Range("IV2:IV" & X), Cells(X, "IV")) > 1 Then Rows(X).Delete
    Next
    [IV:IV].Clear
    Application.ScreenUpdating = True
    MsgBox "İŞLEMİNİZ TAMAMLANMIŞTIR.", vbInformation
End Sub

 

[p_rens]

çok teşekkürler

süper olmuş elinize sağlık

 

[Orion1]

süper olmuş elinize sağlık

Rica ederim.
İyi çalışmalar.

 

[hsayar]

evren hocam benimde aynı yönde bir sorum var fakat biraz içeriği farklı...

a:g arasındaki benzersiz satırlar tabloda kalsın ancak j:k aralığıda toplama aralığı olduğu için benzeriyle toplanarak silinsin bu mümkünmü?

Bu sorum ya gözden kaçtı ya açıklmalar yetersiz kaldı

StNO/StnA/StnB/StnC/StnD/StnE/StnF/StnG/StnH/StnI/StnJ/StnK
1/AAAA/BBBB/CCC/DDDD/EEE/FFFF/GGGG/HHH/1000/2000/3000
15/AAAA/BBBB/CCC/DDDD/EEE/FFFF/GGGG/HHH/1000/2000/3000
32/AAAA/BBBB/CCC/DDDD/EEE/FFFF/GGGG/HHH/1000/2000/3000

ise; Makro sonrası
1/AAAA/BBBB/CCC/DDDD/EEE/FFFF/GGGG/HHH/3000/6000/9000

olarak dönsün demek istedim.
Şimdiden Teşekkürler