Satırda zorunlu hücre alanları

[burhancavus61]

Teşekkür ederim 61 yazıyorum ve oldu. Çok sağolun

 

[burhancavus61]

Bunu sadece K ve L sütunları içinde yapabilirmiyim başka sayfada kullanacağım.

 

[PLİNT]

Yukarıdaki mesajıma sayfa koruması olsada seçii hücreye yazmak için ikinci kod yapmıştım

Bunu sadece K ve L sütunları içinde yapabilirmiyim başka sayfada kullanacağım.

hangisini?

 

[burhancavus61]

Son yaptığınız

 

[PLİNT]

Sayfa korumalı olup,seçilen hücreye yazma izni veren kodu istediniz herhalde; aşağıdaki gibidir
(Range("C3:G150,J3:L150" aralığı) )
"A,B" sütunları gibi koda dahil olmayan hücrelere izin vermez

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
ActiveSheet.Unprotect "123"
On Error GoTo 10
With Range("C3:G150,J3:L150")
.Interior.ColorIndex = xlNone
.Locked = True
.FormulaHidden = True
End With
If Intersect(Target, Range("C3:C150,D3:D150,E3:E150,F3:F150,G3:G150,J3:L150")) Is Nothing Then GoTo 10
If Selection.Cells.Count <> 1 Then: ActiveCell.Select
For Each j In Range("C3:L150")
If j.Column <> 8 And j.Column <> 9 Then
If Selection.Cells.Count = 1 Then ActiveCell.Interior.Color = 65535
If j.Value = "" And WorksheetFunction.CountA(Range("C" & Target.Row & ":G" & Target.Row, "J" & Target.Row & ":L" & Target.Row)) < 8 Then
If ActiveCell <> "" And j <> ActiveCell Then GoTo 10
If j = "" Then
j.Select
j.Locked = False
j.FormulaHidden = False
: GoTo 10
End If
End If: End If: Next
10:
ActiveSheet.Protect "123"
End Sub

 

[PLİNT]

Buda "K1:L150"için

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
ActiveSheet.Unprotect "123"
On Error GoTo 10
sonsat = 150
With Range("K1:L" & sonsat)
.Interior.ColorIndex = xlNone
.Locked = True
.FormulaHidden = True
End With
If Intersect(Target, Range("K1:L" & sonsat)) Is Nothing Then GoTo 10
If Selection.Cells.Count <> 1 Then: ActiveCell.Select
For Each j In Range("K1:L" & sonsat)
If Selection.Cells.Count = 1 Then ActiveCell.Interior.Color = 65535
If j.Value = "" And WorksheetFunction.CountA(Range("K" & Target.Row & ":L" & Target.Row)) < 2 Then
If ActiveCell <> "" And j <> ActiveCell Then GoTo 10
If j = "" Then
j.Select
j.Locked = False
j.FormulaHidden = False
: GoTo 10
End If
End If:  Next
10:
ActiveSheet.Protect "123"
End Sub

 

[burhancavus61]

Sağol üstad işten çıkış yaptım evde deneyeceğim. Emeğin için teşekkürler

 

[burhancavus61]

Hocam bi hata oldu son kodda ama önce şu koda K sütununuda ilave debilirmiyiz. Düzelttim ama çalışmadı.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
ActiveSheet.Unprotect "61" '<-----------------------'
On Error GoTo 10
Range("C3:G150,J3:J150").Interior.ColorIndex = xlNone
If Intersect(Target, Range("C3:C150,D3:D150,E3:E150,F3:F150,G3:G150,J3:J150")) Is Nothing Then GoTo 10
If Selection.Cells.Count <> 1 Then: ActiveCell.Select
For Each j In Range("C3:J150")
If j.Column <> 8 And j.Column <> 9 Then
If Selection.Cells.Count = 1 Then ActiveCell.Interior.Color = 65535
If j.Value = "" And WorksheetFunction.CountA(Range("C" & Target.row & ":G" & Target.row, "J" & Target.row)) < 6 Then
If ActiveCell <> "" And j <> ActiveCell Then GoTo 10
If j = "" Then j.Select: GoTo 10
End If: End If: Next
10:
ActiveSheet.Protect "61", DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFiltering:=True
End Sub

 

[PLİNT]

Range("C3:G150,J3:K150") hücrelerine göre şöyle deneyin;

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
ActiveSheet.Unprotect "61" '<-----------------------'
On Error GoTo 10
Range("C3:G150,J3:K150").Interior.ColorIndex = xlNone
If Intersect(Target, Range("C3:G150,J3:K150")) Is Nothing Then GoTo 10
If Selection.Cells.Count <> 1 Then: ActiveCell.Select
For Each j In Range("C3:K150")
If j.Column <> 8 And j.Column <> 9 Then
If Selection.Cells.Count = 1 Then ActiveCell.Interior.Color = 65535
If j.Value = "" And WorksheetFunction.CountA(Range("C" & Target.Row & ":G" & Target.Row, "J" & Target.Row & ":K" & Target.Row)) < 7 Then
If ActiveCell <> "" And j <> ActiveCell Then GoTo 10
If j = "" Then j.Select: GoTo 10
End If: End If: Next
10:
ActiveSheet.Protect "61", DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFiltering:=True
End Sub

"K1:L150" aralığı için;
kodları pencereye yapıştırdıktan sonra içindeki açıklamalara göre uyarlarsınız
eksiklik oluyorsa "On Error GoTo 10" satırını silerek deneyin, hata verecek olan satıra göre hareket edelim

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
ActiveSheet.Unprotect "123"
On Error GoTo 10
sonsat = 150   'SON SATIR; GEREKTİĞİNE GÖRE ARTIRILIR
With Range("K1:L150")
.Interior.ColorIndex = xlNone
'.Locked = True          'KORUMALI SAYFADA HÜCREYE VERİ GİREBİLMEK İÇİN HÜCRE KİLİDİNİ AÇAR////////
'.FormulaHidden = True
End With
If Intersect(Target, Range("K1:L" & sonsat)) Is Nothing Then GoTo 10 '<---------"K1" İLK SATIR İSTEĞE GÖRE AYARLANIR/////////
If Selection.Cells.Count <> 1 Then: ActiveCell.Select
For Each j In Range("K1:L" & sonsat) '<---------"K1" İLK SATIR İSTEĞE GÖRE AYARLANIR//////////
If Selection.Cells.Count = 1 Then ActiveCell.Interior.Color = 65535
If j.Value = "" And WorksheetFunction.CountA(Range("K" & Target.Row & ":L" & Target.Row)) < 2 Then
If ActiveCell <> "" And j <> ActiveCell Then GoTo 10
If j = "" Then
j.Select
'j.Locked = False   ' HÜCREYİ KİLİTLER////////
: GoTo 10
End If
End If:  Next
10:
ActiveSheet.Protect "123"
End Sub

 

[burhancavus61]

Usta ilk kod J ve K sütununu doldurmadan geçiyor. Ama renkleniyor. J ve K sütununda zorunluluk yok yani J ve K doldurmadan geçiliyor. "On Error GoTo 10" sildim ve hata vermedi. ikinci kodu kullandım olmadı ilk kod üzerinden gidebilirmiyiz. Aşağıdaki kod yani. J ve K aralığı zorunlu olursa tamam olacak gibi.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
ActiveSheet.Unprotect "61" '<-----------------------'
On Error GoTo 10
Range("C3:G150,J3:K150").Interior.ColorIndex = xlNone
If Intersect(Target, Range("C3:G150,J3:K150")) Is Nothing Then GoTo 10
If Selection.Cells.Count <> 1 Then: ActiveCell.Select
For Each j In Range("C3:K150")
If j.Column <> 8 And j.Column <> 9 Then
If Selection.Cells.Count = 1 Then ActiveCell.Interior.Color = 65535
If j.Value = "" And WorksheetFunction.CountA(Range("C" & Target.row & ":G" & Target.row, "J" & Target.row & ":K" & Target.row)) < 7 Then
If ActiveCell <> "" And j <> ActiveCell Then GoTo 10
If j = "" Then j.Select: GoTo 10
End If: End If: Next
10:
ActiveSheet.Protect "61", DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFiltering:=True
End Sub

 

[burhancavus61]

bu arada ikinci kod çalışıyor yanlış sayfada kontrol etmişim onda sorun yok elinize sağlık zahmet veriyorum.

 

[burhancavus61]

Bu kod için yardımınız gerek. J ve K aralığı çalışmıyor

 

[PLİNT]

Çalışmıyor dediğiniz "enter" ilerleme yönünün "sağ" olarak ayarlanmasındanmı?
ayarı "aşağı" olarak değiştirirseniz sorun görünmüyor ancak "sağ" ayarı içinde ek dosyadaki gibi olabilir;
"örnek2" sayfasında "H:I" sütunu seçimi yapılamaz
"örnek1" sayfasında ise seçilen sütunların (Range("C3:G150,J3:K150")) dışında hiçbiri seçilmez
https://www.dosyaupload.com/bdwU

 

[burhancavus61]

J ve K sütununa geldiğimde doldurmadan geçiş yapabiliyorum.

 

[burhancavus61]

J ve K sütunlarında aşağı geçince yukarı atıyor ama sağ tarafa geçiş izni veriyor

 

[PLİNT]

Yukarıda ki ek dosyadaki "örnek1" sayfasındaki gibi olurmu?

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
ActiveSheet.Unprotect "61" '<-----------------------'
On Error GoTo 10
Range("C3:G150,J3:K150").Interior.ColorIndex = xlNone
If Not Intersect(Target, Range("C3:G150,J3:K150")) Is Nothing Then
If Selection.Cells.Count <> 1 Then: ActiveCell.Select
For Each j In Range("C3:K150")
If j.Column <> 8 And j.Column <> 9 Then
If Selection.Cells.Count = 1 Then ActiveCell.Interior.Color = 65535
If j.Value = "" And WorksheetFunction.CountA(Range("C" & Target.Row & ":G" & Target.Row, "J" & Target.Row & ":K" & Target.Row)) < 7 Then
If ActiveCell <> "" And j <> ActiveCell Then GoTo 10
If j = "" Then j.Select: GoTo 10
End If: End If: Next
Else
Cells(Cells(Rows.Count, "C").End(3).Row + 1, "C").Select
End If
10:
'ActiveSheet.Protect "61", DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFiltering:=True
End Sub

 

[burhancavus61]

örnek dosyayı indiremedim

 

[burhancavus61]

son kodda j den k ya geçerken zorunlu olmuyor k işlemek zorunlu aşağı geçince j zorunlu oluyor. bu şekilde işimi görür. sağolun