- Katılım
- 21 Şubat 2007
- Mesajlar
- 351
- Excel Vers. ve Dili
- Microsoft Ev ve Ofis 2016
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Cells(Bak, "A").Delete xlUp
satırını silin, onun yerine aşağıdaki satırı ekleyin.Rows(Bak).Delete
Sub IKIDEN_FAZLASINI_SIL()
Dim s1 As Worksheet, a(), b()
Set s1 = Sheets("Sayfa1")
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
ilk = s1.Cells(Rows.Count, 1).End(3).Row - 1
On Error Resume Next
a = s1.Range("A1:A" & s1.Cells(Rows.Count, 1).End(3).Row).Value
ReDim b(1 To UBound(a), 1 To 1)
For i = 1 To UBound(a)
If a(i, 1) <> a(i + 2, 1) Then
Say = Say + 1
b(Say, 1) = a(i, 1)
End If
Next i
If Say > 0 Then
s1.Range("A1:A" & s1.Cells(Rows.Count, 1).End(3).Row).Clear
s1.[A1].Resize(Say, 1) = b
End If
Erase a: Erase b
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
MsgBox ilk - Say & " adet kayıt silindi.", vbInformation
End Sub
Private Sub btnTekrarlariSil_Click()
IKIDEN_FAZLASINI_SIL
End Sub