Soru Userform ile mükerrer kayıtları sil

[s.savas]

Sub RemoveDuplicateRows()
Dim MyRange As Range
Dim LastRow As Long

LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
Set MyRange = ActiveSheet.Range("A1:D" & LastRow)
MyRange.RemoveDuplicates Columns:=3, Header:=xlYes
End Sub

Merhaba arkadaşlar.
Buradaki algoritma ile; A ile D sütunları aralığındaki kayıtlardan 3.sütun (C sütunu) referans alınarak mükerrer kayıtları siliyor.
Amacım burada tanımlanan sütun başlıklarını textbox lar ile döngüye alıp kodu çalıştırmak.
Yardımlarınızı rica ediyorum.

 

[Korhan Ayhan]

Deneyiniz.

Private Sub CommandButton1_Click()
    Dim Alan As Range, Son_Satir As Long
    
    If TextBox1 = Empty Then
        MsgBox "Lütfen ilk sütun bilgisini giriniz.", vbExclamation
        TextBox1.SetFocus
        Exit Sub
    End If
    
    If TextBox2 = Empty Then
        MsgBox "Lütfen son sütun bilgisini giriniz.", vbExclamation
        TextBox2.SetFocus
        Exit Sub
    End If
    
    If TextBox3 = Empty Then
        MsgBox "Lütfen hedef sütun bilgisini giriniz.", vbExclamation
        TextBox3.SetFocus
        Exit Sub
    End If
    
    With ActiveSheet
        Son_Satir = .Cells.Find("*", .Cells(1, 1), , , xlByRows, xlPrevious).Row
        Set Alan = .Range(TextBox1 & "1:" & TextBox2 & Son_Satir)
        Alan.RemoveDuplicates Columns:=.Range(TextBox3 & 1).Column, Header:=xlYes
    End With
End Sub

 

[s.savas]

Deneyiniz.

Private Sub CommandButton1_Click()
    Dim Alan As Range, Son_Satir As Long
  
    If TextBox1 = Empty Then
        MsgBox "Lütfen ilk sütun bilgisini giriniz.", vbExclamation
        TextBox1.SetFocus
        Exit Sub
    End If
  
    If TextBox2 = Empty Then
        MsgBox "Lütfen son sütun bilgisini giriniz.", vbExclamation
        TextBox2.SetFocus
        Exit Sub
    End If
  
    If TextBox3 = Empty Then
        MsgBox "Lütfen hedef sütun bilgisini giriniz.", vbExclamation
        TextBox3.SetFocus
        Exit Sub
    End If
  
    With ActiveSheet
        Son_Satir = .Cells.Find("*", .Cells(1, 1), , , xlByRows, xlPrevious).Row
        Set Alan = .Range(TextBox1 & "1:" & TextBox2 & Son_Satir)
        Alan.RemoveDuplicates Columns:=.Range(TextBox3 & 1).Column, Header:=xlYes
    End With
End Sub

Çok teşekkürler Korhan hocam, sorunsuz çalıştı.
Küçük bir ilave mümkün olurmu.
Silinen mükerrer kayıt sayısını bir labelde gösterebilirmisiniz.

 

[Korhan Ayhan]

Deneyiniz.

Private Sub CommandButton1_Click()
    Dim Alan As Range, Son_Satir As Long, Kayit_Sayisi As Long
    
    If TextBox1 = Empty Then
        MsgBox "Lütfen ilk sütun bilgisini giriniz.", vbExclamation
        TextBox1.SetFocus
        Exit Sub
    End If
    
    If TextBox2 = Empty Then
        MsgBox "Lütfen son sütun bilgisini giriniz.", vbExclamation
        TextBox2.SetFocus
        Exit Sub
    End If
    
    If TextBox3 = Empty Then
        MsgBox "Lütfen hedef sütun bilgisini giriniz.", vbExclamation
        TextBox3.SetFocus
        Exit Sub
    End If
    
    With ActiveSheet
        Son_Satir = .Cells.Find("*", .Cells(1, 1), , , xlByRows, xlPrevious).Row
        Set Alan = .Range(TextBox1 & "1:" & TextBox2 & Son_Satir)
        Alan.RemoveDuplicates Columns:=.Range(TextBox3 & 1).Column, Header:=xlYes
        Kayit_Sayisi = Son_Satir
        Son_Satir = .Cells.Find("*", .Cells(1, 1), , , xlByRows, xlPrevious).Row
        Label4.Caption = "Silinen Mükerrer Kayıt Sayısı = " & Format(Kayit_Sayisi - Son_Satir, "#,##0")
    End With
End Sub

 

[s.savas]

Deneyiniz.

Private Sub CommandButton1_Click()
    Dim Alan As Range, Son_Satir As Long, Kayit_Sayisi As Long
   
    If TextBox1 = Empty Then
        MsgBox "Lütfen ilk sütun bilgisini giriniz.", vbExclamation
        TextBox1.SetFocus
        Exit Sub
    End If
   
    If TextBox2 = Empty Then
        MsgBox "Lütfen son sütun bilgisini giriniz.", vbExclamation
        TextBox2.SetFocus
        Exit Sub
    End If
   
    If TextBox3 = Empty Then
        MsgBox "Lütfen hedef sütun bilgisini giriniz.", vbExclamation
        TextBox3.SetFocus
        Exit Sub
    End If
   
    With ActiveSheet
        Son_Satir = .Cells.Find("*", .Cells(1, 1), , , xlByRows, xlPrevious).Row
        Set Alan = .Range(TextBox1 & "1:" & TextBox2 & Son_Satir)
        Alan.RemoveDuplicates Columns:=.Range(TextBox3 & 1).Column, Header:=xlYes
        Kayit_Sayisi = Son_Satir
        Son_Satir = .Cells.Find("*", .Cells(1, 1), , , xlByRows, xlPrevious).Row
        Label4.Caption = "Silinen Mükerrer Kayıt Sayısı = " & Format(Kayit_Sayisi - Son_Satir, "#,##0")
    End With
End Sub

Tekrar teşekkürler. Kod çalışıyor.