Sol Hücre Boşsa Hücreye Değer Girerken Uyarı Verme

[katip16487]

L12:L131 hücrelerine ancak değer girilmeye çalışılan hücre ile aynı satırdaki K hücresinin boş olması halinde değer girilememesini sağlamak istiyorum...

L12 hücresi için örnek veriyorum...

K12 hücresi boş ise L12'ye değer girilmeye çalışıldığında LÜTFEN K12 hücresine DEĞER GİRİNİZ... şeklinde uyarı vermesini ve değerin girilmesini engellemesini istiyorum...

Saygılarımla....

[Bülent Öztürk]

İlgili sayfanın Change olayına aşağıdaki kodları yazıp deneyin;

Kod: [Seç]

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 12 Then Exit Sub
If Target.Row < 12 Then Exit Sub
If Target.Row > 131 Then Exit Sub
If Target.Offset(0, -1) = "" Then
    Application.EnableEvents = False
    MsgBox "Lütfen K:" & Target.Row & " hücresine değer giriniz!"
    Target = Empty
    Target.Offset(0, -1).Select
    Application.EnableEvents = True
End If
End Sub

[katip16487]

Bülent Bey , verdiğiniz cevap için teşekkürler...

Ancak şöyle bir sorunum ortaya çıktı...

Tabii bu benim size eksik bilgi vermemden kaynaklanıyor, kusura bakmayın...


Merhaba öncelikle yardımlarınız için teşekkür ederim…
Verdiğiniz kodlar üzerinde işlem yaparak aşağıdaki kodu oluşturdum…
Ancak aşağıdaki kodu veya yine aşağıda yer alan makroları çalıştırmayı denediğimde;

Run – Time Error “13”:
Type Mismatch

hatası alıyorum.
Hatanın nedenini ise kendim MAKROLARIN KODLARIN yazılı bulunduğu hücrelere başvuru yapması olarak düşünüyorum…

Hatanın alınması anında END yaptığımda herhangi bir sorun oluşturmuyor…
Ancak ben bu hatanın alınmamasını nasıl sağlayabilirim…

DEBUG yaptığımda ise aşağıdaki hatayı alıyorum…


Saygılarımla…


Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [L12:L131]) Is Nothing Then GoTo atla
If Target <> "" Then
If Target.Offset(0, -1).Value = "" Then
MsgBox "LÜTFEN ÖDEME TARİHİ BİLGİSİ GİRİNİZ...", , "Ödeme tarihi bilgisi boş olamaz..."
Target.Select
Target = ""
End If
End If
atla:
Dim Satır As Integer
If Intersect(Target, Range("K12:K131")) Is Nothing Then Exit Sub
If Target.Cells.Count > 1 Then Exit Sub
If Target <> "" Then
Satır = Target.End(3).Row + 1
If Satır >= Target.Row Then Exit Sub
If Cells(Satır, Target.Column) = "" Then
Range(Cells(Satır, Target.Column), Cells(Target.Row - 1, Target.Column)) = CDate(Target)
Range("K12:K131").NumberFormat = "dd.mm.yyyy"
End If
End If
End Sub




Sub ODEMESİL()
'
' ODEMESİL Makro
' Makro HASAN BERA KULA tarafından 09.05.2012 tarihinde kaydedildi.
'

'
Range("K12:L131").Select
Selection.ClearContents
Range("F1").Select
End Sub




Sub YENİHESAP()
'
' YENİHESAP Makro
' Makro AB78461 tarafından 27.04.2012 tarihinde kaydedildi.
'

'
Range("K4").Select
Selection.ClearContents
Range("F1:F6").Select
Selection.ClearContents
ActiveWindow.SmallScroll Down:=-3
Range("K12:L131").Select
Selection.ClearContents
Range("K12").Select
Application.CutCopyMode = False
End Sub



Hata almayı nasıl düzeltebilirim...

Saygılarımla...

[Bülent Öztürk]

Private Sub Worksheet_Change(ByVal Target As Range)
olayındaki kendi kodlarınızın üzerine şunu ekleyip deneyin:

Kod: [Seç]

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 12 Then Exit Sub
If Target.Row < 12 Then Exit Sub
If Target.Row > 131 Then Exit Sub
If Target.Offset(0, -1) = "" Then
    Application.EnableEvents = False
    MsgBox "Lütfen K:" & Target.Row & " hücresine değer giriniz!"
    Target = Empty
    Target.Offset(0, -1).Select
    Application.EnableEvents = True
End If
End Sub