Formüllü hücre silinmesin

[woodteacher]

İyi günler arkadaşlar , bu konuda yardımcı olabilirseniz sevinirim.

hücrede formül varsa silinmesin istiyorum...

örnek çalışmayı eke koydum...

 

[bedersu]

Sayın woodteacher,
Hücrelerdeki veriler formüller ile alındığı için,formüller silinmediği sürece hücrede her zaman bir veri olur çünkü hesaplama devam eder.Sadece verileri gizleyebilirsiniz.Bunu da sayfayı korumadığınız sürece yapamazsınız.
Eğer formül olan hücre silinmesin istiyorsanız aşağıdaki kodları kullanabilirsiniz:


Sub auto_open()
Application.OnKey "{del}", "Sil"

End Sub

Sub sil()

If ActiveCell.HasFormula = True Then Exit Sub Else ActiveCell.ClearContents

End Sub

Sub auto_close()
Application.OnKey "{del}"

End Sub

 

[woodteacher]

bedersu hanım
teşekkürler ederim , desteğiniz için.Sanırım haklısınız.
Tam olarak istediğim şeyi düzelttim.
yukarıdaki ilk mesaja bakabilirseniz

 

[Korhan Ayhan]

Merhaba,

Bu işlemi makro ile yapmanız daha uygun olur. Aşağıdaki kodu SİPARİŞ isimli sayfanızın kod bölümüne uygulayın.

Ürün adı girdiğinizde bilgiler otomatik gelecektir. Eğer ürün yoksa size uyarı verecek TAMAM dediğinizde ürün adı LİSTE isimli sayfaya eklenecektir. Size sadece rengini girmek kalacak.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim S1, S2, BUL, Satir
    
    If Intersect(Target, Range("B3:B" & Rows.Count)) Is Nothing Then Exit Sub
    If Target.Cells.Count > 1 Then Exit Sub
    
    If Target <> "" Then
        Set S1 = Sheets("SİPARİŞ")
        Set S2 = Sheets("liste")
        
        Set BUL = S2.Range("A:A").Find(Target, , , xlWhole)
        If Not BUL Is Nothing Then
            Target.Next = BUL.Offset(0, 1)
        Else
            If MsgBox(Target & " isimli ürün bulunamadı!" & Chr(10) & _
                   "Liste sayfasına eklemek ister misiniz?", vbCritical + vbOKCancel) = vbCancel Then Exit Sub
            Satir = S2.Cells(Rows.Count, 1).End(3).Row + 1
            S2.Cells(Satir, 1) = Target
            S2.Cells(Satir, 2) = Target.Next
        End If
    End If
End Sub

 

[woodteacher]

Korhan hocam siz çok mükemmel bir insansınız.
Çok teşekkür ediyorum , desteğiniz için.
İstediğim tam olarak buydu..Tek bir sıkıntı ürün kodunda ilk yazdığım yeni ürüne kendi otomatik renk veriyor,boş geçse daha güzel olacak çünkü yanıltma ihtimali var.

 

[Korhan Ayhan]

Merhaba,

Üstteki mesajımdaki koda küçük bir ekleme yaptım. Son halini denermisiniz.

 

[woodteacher]

Korhan hocam
Yeni ürünü listeye ekletmeden yapabilirmiyiz....

 

[Korhan Ayhan]

Merhaba,

Aşağıdaki satırları silin.

        Else
            If MsgBox(Target & " isimli ürün bulunamadı!" & Chr(10) & _
                   "Liste sayfasına eklemek ister misiniz?", vbCritical + vbOKCancel) = vbCancel Then Exit Sub
            Satir = S2.Cells(Rows.Count, 1).End(3).Row + 1
            S2.Cells(Satir, 1) = Target
            S2.Cells(Satir, 2) = Target.Next

 

[woodteacher]

Korhan hocam
Çok teşekkür ederim , istediğim sonucu aldım....
Zahmet verdim , hakkınız helal edin..

 

[woodteacher]

Korhan hocam sadece lazım olur diye soruyorum..

Çalışmada aynı formülü 4 sutuna veya daha fazla sutuna uyacak şekilde açabilirmiyiz

Örnek dosya ekte....

 

[Korhan Ayhan]

Merhaba,

Elbette genişletilebilir. Aşağıdaki satırı silip bir sonraki kod bloğunu deneyin.

Target.Next = BUL.Offset(0, 1)

Olması gereken;

Cells(Target.Row, "C") = BUL.Offset(0, 1)
Cells(Target.Row, "D") = BUL.Offset(0, 2)
Cells(Target.Row, "E") = BUL.Offset(0, 3)

 

[woodteacher]

Korhan hocam teşekkür ederim...Sutun sayısını artırdı..
Şöyle birşey dikkatimi çekti
Seçtiğimiz ÜRÜN KODUN daki değeri silince düşeraradan gelen C-D-E deki değerler kalıyor.ÜRÜN KODUNDAKİ değeri silince , otomatik silinebilirmi..

 

[woodteacher]

Korhan hocam
Verdiğiniz formüllerde ekle ve çıkar dediğiniz şeyleri uyguluyunca
Bu formül oluştu. / buna 1 yukarıda belirtiğim gibi silme işlemini ekleyebilirmiyiz..

Private Sub Worksheet_Change(ByVal Target As Range)
Dim S1, S2, BUL, Satir

If Intersect(Target, Range("B3:B" & Rows.Count)) Is Nothing Then Exit Sub
If Target.Cells.Count > 1 Then Exit Sub

If Target <> "" Then
Set S1 = Sheets("SİPARİŞ FORMU")
Set S2 = Sheets("ÜRÜN GRUBU")

Set BUL = S2.Range("A:A").Find(Target, , , xlWhole)
If Not BUL Is Nothing Then
Cells(Target.Row, "C") = BUL.Offset(0, 1)
Cells(Target.Row, "D") = BUL.Offset(0, 2)
Cells(Target.Row, "E") = BUL.Offset(0, 3)

End If
End If
End Sub

 

[woodteacher]

Günaydın Korhan hocam..Umarım güne enerjik başlamışsınızdır..
Hocam son iki mesajıma bakabildinizmi...

 

[Korhan Ayhan]

Merhaba,

Aşağıdaki kodu deneyin.

Çoklu hücre silmelerinde kod tepki vermez. Bu sebeple Bu tarz silme işlemi yapacaksanız yandaki sütunlardaki hücreleride seçip siliniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim S1, S2, BUL, Satir
 
    If Intersect(Target, Range("B3:B" & Rows.Count)) Is Nothing Then Exit Sub
    If Target.Cells.Count > 1 Then Exit Sub
 
    If Target <> "" Then
        Set S1 = Sheets("SİPARİŞ FORMU")
        Set S2 = Sheets("ÜRÜN GRUBU")
 
        Set BUL = S2.Range("A:A").Find(Target, , , xlWhole)
        If Not BUL Is Nothing Then
            Cells(Target.Row, "C") = BUL.Offset(0, 1)
            Cells(Target.Row, "D") = BUL.Offset(0, 2)
            Cells(Target.Row, "E") = BUL.Offset(0, 3)
        End If
    Else
        Range("C" & Target.Row & ":E" & Target.Row).ClearContents
    End If
End Sub

 

[woodteacher]

Korhan hocam çok teşekkür ederim...
Sayenizde bir çalışmayıda bitirmiş oldum, çok güzel oldu...