Soru Çift Tıkla Verilerin Silinmesi

[reosman]

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim Alan As Range
Dim yeni As Integer
Dim A, son As Integer
Set Alan = Range("F2:F1045876")
If Not Intersect(Target, Alan) Is Nothing Then
Cancel = True
If IsEmpty(Target) Then
Target = "İZ OLDU"
son = Sheets("İz").Cells(Rows.Count, "B").End(3).Row
A = Target.Row
If WorksheetFunction.CountIfs(Sheets("İz").Range("B1:B" & son), Cells(A, "B"), Sheets("İz").Range("C1:C" & son), Cells(A, "C"), _
Sheets("İz").Range("D1" & son), Cells(A, "D"), Sheets("İz").Range("E1:E" & son), Cells(A, "E")) = 0 Then
Range("B" & A & ":E" & A).Copy Sheets("İz").Cells(son + 1, "B")
Sheets("İz").Cells(son + 1, "A") = son
Else
MsgBox "İz Sayfasında Aynı Veri Bulunmaktadır!!", 16, "Dikkat"
End If
Else
Target.ClearContents
End If
End If
End sub


Bu kodla sayfadaki F sütunuta çift tıkladığımda "İZ OLDU" yazıyor ve verileri İz sayfasına gönderiyor.

İkinci defa çift tıkladığımda "İZ OLDU" ifadesi kalkıyor.

Yapmak istediğim "İZ OLDU" ifadesinin kaldırılmasının ardından İz sayfasına gönderilen verinin (satırın) silinmesi ve sıralanmasıdır.

Yardımlarınızı rica ediyorum.

 

[Korhan Ayhan]

Merhaba,

Öncelikle bu tarz sorularınızı örnek dosya ile desteklemeniz sorunun cevaplanma sürecini hızlandıracaktır. Ben bu tarz sorulara cevap verirken tereddüt ediyorum. Çünkü anladığımız şekilde cevap veriyoruz ve sonrasında "şurası şöyleydi, burası böyleydi" ya da "Benim asıl dosyamda başka bir kod var. Bu kodla sizin önerdiğiniz kodu nasıl birleştirebilirim." gibi ifadeler ile konu gereksiz yere uzayıp gidiyor. Burada talep edilen örnek dosya gerçek veriler içermeyen ve boyutu minimize edilmiş ama cevap verecek kişiyi yönlendirebilecek kadar detayı gösteren yapıda olmalıdır. Yani örnek dosyanız; dosyayı inceleyen kişinin sorunuzu bir çırpıda anlayabileceği yapıda olmalıdır.

"İz" sayfasında çift tıkladığınız satırı yakalamak için bir parametreniz var mı? Her kayıt için benzersiz bir alan varsa bu kullanılarak "İz" sayfasında bulunarak ilgili satır silinebilir.

 

[reosman]

Korhan Ayhan hocam,
Kusuruma bakmayın dosyam ektedir. Saygılarımla.

 

[Korhan Ayhan]

Kullandığınız kod bloğunda aşağıdaki satırı bir sonraki bölümle değiştirip deneyiniz.

Dim bölümüne Dim Bul As Range ekleyiniz.

Eski hali;

Target.ClearContents

Yeni hali;

            Target.ClearContents
            Set Bul = Sheets("İz").Range("D:D").Find(Cells(Target.Row, "D"), , , xlWhole)
            If Not Bul Is Nothing Then
                Bul.Offset(, -3).Resize(, 5).ClearContents
                If WorksheetFunction.CountA(Sheets("İz").Range("A2:A" & Rows.Count)) > 0 Then
                    Sheets("İz").Range("A2:F" & Rows.Count).Sort Key1:=Sheets("İz").Range("A2"), Order1:=xlAscending, Header:=xlNo
                    son = Sheets("İz").Cells(Rows.Count, "B").End(3).Row
                    Sheets("İz").Range("A2") = 1
                    Sheets("İz").Range("A2:A" & son).DataSeries Rowcol:=xlColumns, Type:=xlLinear, Step:=1
                End If
            End If

Kodun bitiş satırının üstüne de aşağıdaki satırı ekleyiniz.

Set Bul = Nothing

 

[reosman]

çok teşekkür ederim hocam çalıştırdım. Saygılarımla.