DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub sil()
Dim sat1, sat2 As Integer
For sat1 = 1 To Cells(65536, "a").End(xlUp).Row
For sat2 = 1 To Cells(65536, "c").End(xlUp).Row
If Cells(sat1, "a") Like Cells(sat2, "c") Then
Cells(sat1, "a").Delete shift:=xlUp
End If
Next: Next
End Sub
Cells(sat1, "a").EntireRow.Clear 'hücrelerin içeriğini siler
Cells(sat1, "a").EntireRow.Delete 'komple satırı siler
Sub sil()
Dim sat1, sat2 As Integer
For sat1 = 1 To Cells(65536, "b").End(xlUp).Row
For sat2 = 1 To Cells(65536, "f").End(xlUp).Row
If Cells(sat1, "b") Like Cells(sat2, "f") Then
Range(Cells(sat1, "a"), Cells(sat1, "c")).Delete shift:=xlUp
End If
Next: Next
End Sub
Sub Sil()
Application.ScreenUpdating = False
For x = [b65536].End(3).Row To 1 Step -1
Say = WorksheetFunction.CountIf(Range("k1:k" & [k65536].End(3).Row), Cells(x, "g"))
If Say > 0 Then
q = q + 1
Range(Cells(x, "a"), Cells(x, "g")).Delete shift:=xlUp
End If
Next
If q > 0 Then
MsgBox "Silme işlemi tamamlandı. Silinen veri sayısı: " & q, vbInformation, "DURUM"
Else:
MsgBox "Silinecek veri bulunamadı.", vbInformation, "DURUM"
End If
End Sub
Üst mesajımdaki dosyayı güncelledim. Yeniden indirebilirsiniz.evet bu sekıl l sutunu ıcınde aynısı olacak aslında