Hücre İçindeki Değeri Bulup Sil

[tamer060]

Merhabalar tekboxt'a değer yazıdığımda F ile BC sütünları arasında arayıp bulup silmesini istiyorum Ek'te örnek mevcuttur. Şimdiden Yardım edenlere Teşekkürler.

 

[meslan]

Merhaba

Private Sub CommandButton1_Click()
[F:BC].Replace What:=TextBox1.Value, Replacement:="", LookAt:=xlWhole
End Sub

Kolay gelsin.

 

[tamer060]

Güzel bir kod Teşekkür ederim.
Private Sub TextBox1_Change()
[F:BC].Replace What:=TextBox1.Value, Replacement:="", LookAt:=xlWhole
End Sub

Öğrenmek Amaçlı soruyorum Sayın Meslan Tetbox içinde değilde hücre içine yazılan değeri bulunup silmesini isteseydik nasıl olurdu?

 

[tamer060]

ayrıca yazdığınız koda mesaj ekliyebilirmiyiz Aradığın değer silindi bir mesaj ise aradığınız değer bulunamadı.

 

[meslan]

Güzel bir kod Teşekkür ederim.
Öğrenmek Amaçlı soruyorum Sayın Meslan Tetbox içinde değilde hücre içine yazılan değeri bulunup silmesini isteseydik nasıl olurdu?

A1 e değer girerek deneyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target.Rows, [A1]) Is Nothing Then Exit Sub
Set bul = [F:BC].Find(Target.Value, lookat:=xlWhole)
If bul Is Nothing Then MsgBox "Aranan değer bulunamadı.": Exit Sub
[F:BC].Replace What:=Target.Value, Replacement:="", lookat:=xlWhole
MsgBox "Aranan değerler Silindi", vbCritical, Application.UserName
End Sub

 

[meslan]

ayrıca yazdığınız koda mesaj ekliyebilirmiyiz Aradığın değer silindi bir mesaj ise aradığınız değer bulunamadı.

Private Sub CommandButton1_Click()
Set bul = [F:BC].Find(TextBox1.Value, lookat:=xlWhole)
If bul Is Nothing Then MsgBox "Aranan değer bulunamadı.": Exit Sub
[F:BC].Replace What:=TextBox1.Value, Replacement:="", lookat:=xlWhole
MsgBox "Aranan değerler Silindi", vbCritical, Application.UserName
End Sub

 

[halit3]

alternatif uygulama

userform için

Private Sub CommandButton1_Click()
deg1 = 0
son = 0
For i = 1 To 255
yer1 = Worksheets(ActiveSheet.Name).Cells(65536, i).End(xlUp).Row
If deg1 > yer1 Then
deg1 = deg1
ElseIf deg1 < yer1 Then
deg1 = yer1
End If
Next i
Dim x As Range
For Each x In Range("F1:BC" & deg1)
If TextBox1.Text <> "" Then
If x.Value = TextBox1.Text Then

a = MsgBox(x.Address & " silmek istiyormusunuz..?", vbYesNo + vbInformation, "")
If a = vbYes Then
x.Value = ""
MsgBox x.Address & " silindi"
End If
End If
End If
Next
MsgBox son
If son = 0 Then
MsgBox "aradığınız değer bulunamadı"
End If
End Sub

al hücresindeki değer için

Sub sil()
deg1 = 0
son = 0
For i = 1 To 255
yer1 = Worksheets(ActiveSheet.Name).Cells(65536, i).End(xlUp).Row
If deg1 > yer1 Then
deg1 = deg1
ElseIf deg1 < yer1 Then
deg1 = yer1
End If
Next i
Dim x As Range
For Each x In Range("F1:BC" & deg1)
If Cells(1, "A").Value <> "" Then
If x.Value = Cells(1, "A").Value Then
son = 1
a = MsgBox(x.Address & " silmek istiyormusunuz..?", vbYesNo + vbInformation, "")
If a = vbYes Then
x.Value = ""
MsgBox x.Address & " silindi"
End If
End If
End If
Next
If son = 0 Then
MsgBox "aradığınız değer bulunamadı"
End If
End Sub

 

[halit3]

kodları yeniden düzenledim.

 

[tamer060]

Teşekkür ederim ellerinize sağlık hemen deniyip kavramaya çalışacağım sağolun..