Hücre Boş İse Geçilemesin

[thugangel]

Merhabalar. Aşağıdaki kod B1:B8 için çalışıyor. Ancak B7:G7 için uyarlayamadım.Yardımcı olabilir misiniz?

Public col As Integer
Public row As Integer
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("B1:B8")) Is Nothing Then Exit Sub
If row <> 0 Then
If Cells(row, col) = "" And Target.row <> row Then
MsgBox ("boş geçemezsiniz")
Cells(row, col).Select
Exit Sub
End If
End If
If Target.row <> row Then
row = Target.row
col = Target.Column
End If
End Sub

 

[thugangel]

Arkadaşlar yardım lütfen. Kodları düzenlemeye çalıştım ama beceremedim.

 

[Ömer]

Merhaba,

Bu şekilde deneyin.

Public col As Integer
Public row As Integer
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("B7:G7")) Is Nothing Then Exit Sub
If col <> 0 Then
If Cells(row, col) = "" And Target.Column <> col Then
MsgBox ("boş geçemezsiniz")
Cells(row, col).Select
Exit Sub
End If
End If
If Target.Column <> col Then
col = Target.Column
row = 7
End If
End Sub

.

 

[thugangel]

Ömer Bey Çok teşekkür ederim. Ellerinize sağlık.

 

[Seyit Tiken]

Kodta ufak bir müdahaleyle yapılabilirdi.

If Intersect(Target, Range("B1:B8,B7:G7")) Is Nothing Then Exit Sub

 

[ikikan]

Public col As Integer
Public row As Integer
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
SonSatir = Cells(Rows.Count, 1).End(xlUp).row

If Intersect(Target, Range("A11:A& SonSatir")) Is Nothing Then Exit Sub
If row <> 0 Then
If Cells(row, col) = "" And Target.row <> row Then
MsgBox ("boş geçemezsiniz")
Cells(row, col).Select
Exit Sub
End If
End If
If Target.row <> row Then
row = Target.row
col = Target.Column
End If
End Sub

Bu kod Bende neden çalışmiyor arkadaşlar nerde hata yapıyorum...?

 

[YUSUF44]

Bu kod Bende neden çalışmiyor arkadaşlar nerde hata yapıyorum...?

Bu kodla ne amaçlıyorsunuz anlamadım. Ancak

If Intersect(Target, Range("A11:A&SonSatir")) Is Nothing Then Exit Sub

yerine

If Intersect(Target, Range("A11:A" & SonSatir)) Is Nothing Then Exit Sub

şeklinde kullanılması gerekir. Koddaki diğer satırlar ne işe yarıyor çözemedim.

If row <> 0 Then

satırında row geçiyor ama daha önce row tanımlanmamış.

If Cells(row, col) = "" And Target.row <> row Then

satırında hem row hem col geçiyor, her ikisi de önceden tanımlanmamış.

Siz tam olarak ne yapmak istediğinizi açıklarsanız daha fazla yardımcı oluruz.

 

[ikikan]

A Sütununda hücreye veri girmeden yana sütundaki hücrelere veri girilemememesi...

 

[YUSUF44]

Aşağıdaki kodları ilgili sayfanın kod bölümüne yapıştırıp deneyiniz. A boşken B'ye veri girdirmez, A'ya veri girildiğinde B'ye geçer:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B:B]) Is Nothing Then GoTo 10
Application.EnableEvents = False
If Target.Offset(0, -1) = "" Then
    MsgBox "A" & Target.row & " hücresi boşken B" & Target.row & " hücresine veri giremezsiniz", vbCritical
    Target = ""
    Target.Offset(0, -1).Select
End If
Application.EnableEvents = True
10:
If Intersect(Target, [A:A]) Is Nothing Then Exit Sub
Target.Offset(0, 1).Select
End Sub

 

[ikikan]

Sadece B değil B ve P aralığı lazım...;
A sütununa veri girilmeden B ve P aralıgına veri girilmemesi lazım...

 

[YUSUF44]

Sadece B değil B ve P aralığı lazım...;
A sütununa veri girilmeden B ve P aralıgına veri girilmemesi lazım...

Bunu daha önce belirtmediniz. Ben "tam olarak ne istediğinizi" sormuştum, siz "A sütununun yanındaki sütun" diye belirttiniz.

Aşağıdaki kodu deneyin, ben cepten deneyemedim:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B:P]) Is Nothing Then GoTo 10
Application.EnableEvents = False
If cells(Target.Row, "A") = "" Then
    MsgBox "A" & Target.row & " hücresi boşken bu hücreye veri giremezsiniz", vbCritical
    Target = ""
    Cells(Target.Row, "A").Select
End If
Application.EnableEvents = True
10:
If Intersect(Target, [A:A]) Is Nothing Then Exit Sub
Target.Offset(0, 1).Select
End Sub