Satırda zorunlu hücre alanları

burhancavus61

Altın Üye
Katılım
13 Mayıs 2005
Mesajlar
756
Excel Vers. ve Dili
2010 Türkçe
Sayfadaki satırda C D E F G H hücreleri dolmadan diğer hücreye geçiş izni vermemek mümkünmü ve makro ile. bu hücrelerden birine veri yazınca mutlaka diğerlerinide doldurmak zorunda olmalı. Sadece C D E F G ve H sütunları için geçerli olmalı 150. satıra kadar.
 

AdemCan

Altın Üye
Destek Ekibi
Katılım
1 Eylül 2008
Mesajlar
1,337
Excel Vers. ve Dili
2019 TR
Bu konuya benzer olarak daha önce 3 Koşullu uyarı isimli konuda 2 numaralı mesajda paylaştığım kod işinize yarayabilir.
 

burhancavus61

Altın Üye
Katılım
13 Mayıs 2005
Mesajlar
756
Excel Vers. ve Dili
2010 Türkçe
Buna benzer ama ben mesela a hücresini doldurdum b hücresini doldurmadan c ye izin vermesin c dolmadan d ye izin vermesin bunun gibi istiyorum taki h hücreside dolduktan sonra diğe hücrelere izin versin.
 
Katılım
31 Aralık 2014
Mesajlar
1,845
Excel Vers. ve Dili
Excel 2010
Merhaba
Aşağıdaki gibi işinize yararmı?
İlgili sayfanın kod penceresine yazıp deneyiniz
("C" ve "H" sütunları aralıkları dışındaki seçimler hariç)
Kod:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("C1:C150,D1:D150,E1:E150,F1:F150,G1:G150,H1:H150")) Is Nothing Then Exit Sub
For Each j In Range("C1:H150")
If j.Value = "" And WorksheetFunction.CountA(Range("C" & Target.Row & ":H" & Target.Row)) < 6 Then
If j = "" Then j.Select: Exit Sub
End If: Next
End Sub
"C" ve "H" sütunları aralıkları dışındaki seçimlerde dahil olsun derseniz;
Kod:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("C1:C150,D1:D150,E1:E150,F1:F150,G1:G150,H1:H150")) Is Nothing Then
For Each j In Range("C1:H150")
If j.Value = "" And WorksheetFunction.CountA(Range("C" & Target.Row & ":H" & Target.Row)) < 6 Then
If j = "" Then j.Select: Exit Sub
End If: Next
Else
Cells(Cells(Rows.Count, "C").End(3).Row + 1, "C").Select
End If
End Sub
 
Son düzenleme:

burhancavus61

Altın Üye
Katılım
13 Mayıs 2005
Mesajlar
756
Excel Vers. ve Dili
2010 Türkçe
C son satıra tıklayın ca en üste atıyor dson satırına geçmeme izin vermiyor
 

burhancavus61

Altın Üye
Katılım
13 Mayıs 2005
Mesajlar
756
Excel Vers. ve Dili
2010 Türkçe
C3 satırını doldurup D3 satırına geçeceğim D3 doldurmadan E3 e geçmeme izin vermemesi lazım. her satırda aynı mantık
 
Katılım
31 Aralık 2014
Mesajlar
1,845
Excel Vers. ve Dili
Excel 2010
Kodlardaki aşağıdaki "1" leri kaçıncı sütundan itibaren veri yazıyorsanız değişmelisiniz

If Not Intersect(Target, Range("C1:C150,D1: D50,E1:E150,F1:F150,G1:G150,H1:H150")) Is Nothing Then
For Each j In Range("C1:H150")


Ekteki örnekte "C3:H150" aralığı ayarlı
https://dosyaup.com/d/EFWQCGZLJ

Acaba yanlışmı anladım;
"Yan hücreye geçemeyecek ama alt satıra geçebilecek" gibimi?
 

burhancavus61

Altın Üye
Katılım
13 Mayıs 2005
Mesajlar
756
Excel Vers. ve Dili
2010 Türkçe
anladım galiba ama ilk giriş yaptığım yere düzeltme için dönebilmem lazım.
 

burhancavus61

Altın Üye
Katılım
13 Mayıs 2005
Mesajlar
756
Excel Vers. ve Dili
2010 Türkçe
makro güzel çalışıyor fakat sizin kodlarda geri dönüyor ama bende dönmüyor. kendime göre uyarlamıştım

Kod:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("C3:C150,D3:D150,E3:E150,F3:F150,G3:G150,J3:J150")) Is Nothing Then Exit Sub
For Each j In Range("C3:J150")
If j.Value = "" And WorksheetFunction.CountA(Range("C" & Target.row & ":J" & Target.row)) < 9 Then
If j = "" Then j.Select: Exit Sub
End If: Next
End Sub
 
Katılım
31 Aralık 2014
Mesajlar
1,845
Excel Vers. ve Dili
Excel 2010
Range("C3:C150,D3: D150,E3:E150,F3:F150,G3:G150,J3:J150"))


"H" sütunun yerine "J" sütununumu aldınız,
"H" ve "I" sütunu olmayacaksa ona göre düzenleyelim

"H" ,"I" ve "J" sütunları dahil ise ve düzenlemek için geri dönmek gerekirse şöyle
Kod:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("C3:C150,D3:D150,E3:E150,F3:F150,G3:G150,H3:H150,I3:I150,J3:J150")) Is Nothing Then Exit Sub
If Selection.Cells.Count <> 1 Then ActiveCell.Activate
For Each j In Range("C3:J150")
If j.Value = "" And WorksheetFunction.CountA(Range("C" & Target.Row & ":H" & Target.Row)) < 6 Then
If ActiveCell <> "" And j <> ActiveCell Then Exit Sub
If j = "" Then j.Select: Exit Sub
End If: Next
End Sub
 
Son düzenleme:

burhancavus61

Altın Üye
Katılım
13 Mayıs 2005
Mesajlar
756
Excel Vers. ve Dili
2010 Türkçe
H ve I atlamam gerek yanlış yönlendirdim sizi H ve I yok
 

burhancavus61

Altın Üye
Katılım
13 Mayıs 2005
Mesajlar
756
Excel Vers. ve Dili
2010 Türkçe
Ama o sütunları doldurdum bu şekilde de işimi gördü. H ve I sütununu atlamak isteseydim nasıl yapmalıydım peki.
 
Katılım
31 Aralık 2014
Mesajlar
1,845
Excel Vers. ve Dili
Excel 2010
Ama o sütunları doldurdum bu şekilde de işimi gördü. H ve I sütununu atlamak isteseydim nasıl yapmalıydım peki.
Ekteki gibi
https://dosyaup.com/d/FGAYIJVM
Şöyle;
Kod:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("C3:C150,D3:D150,E3:E150,F3:F150,G3:G150,J3:J150")) Is Nothing Then Exit Sub
If Selection.Cells.Count <> 1 Then ActiveCell.Activate
For Each j In Range("C3:G150,J3:J150")
If j.Value = "" And WorksheetFunction.CountA(Range("C" & Target.Row & ":H" & Target.Row)) < 6 Then
If ActiveCell <> "" And j <> ActiveCell Then Exit Sub
If j = "" Then j.Select: Exit Sub
End If: Next
End Sub
 

burhancavus61

Altın Üye
Katılım
13 Mayıs 2005
Mesajlar
756
Excel Vers. ve Dili
2010 Türkçe
Çok güzel oldu teşekkür ederim. İmlecin olduğu alanı sarı renklendirebilirmiyiz. Yazdıktan sonra tekrar dolgu rengi olmasın bu makroya ilave edebilirmiyiz.
 
Katılım
31 Aralık 2014
Mesajlar
1,845
Excel Vers. ve Dili
Excel 2010
Aşağıdaki gibi deneyin, hem yukarıdaki son eklediğim kodda eksiklik gördüm
https://dosyaup.com/d/IIQT
Kod:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
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 Exit Sub
If Selection.Cells.Count <> 1 Then ActiveCell.Activate
For Each j In Range("C3:J150")
If j.Column <> 8 And j.Column <> 9 Then
Target.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 Exit Sub
If j = "" Then j.Select: Exit Sub
End If: End If: Next
End Sub
 
Katılım
31 Aralık 2014
Mesajlar
1,845
Excel Vers. ve Dili
Excel 2010
Rica ederim güle güle kullanın ayrıca aşağıdaki gibide Sayfa hücreleri komple seçilirse hata vermesin;
Kod:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
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 Exit Sub
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 Exit Sub
If j = "" Then j.Select: Exit Sub
End If: End If: Next
10:
End Sub
 

burhancavus61

Altın Üye
Katılım
13 Mayıs 2005
Mesajlar
756
Excel Vers. ve Dili
2010 Türkçe
Hocam merhaba; kod çalışıyor. Sayfa koruması yaptığımda çalışmıyor. Bu sorunu nasıl çözeriz.
 
Katılım
31 Aralık 2014
Mesajlar
1,845
Excel Vers. ve Dili
Excel 2010
Kodlar aşağıdaki gibi çalışacaktır ama nasıl yazıyorsunuz?
(123 leri şifrenizle değiştirirsiniz)
Kod:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
ActiveSheet.Unprotect "123" '<-----------------------'
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 "123"  '<--------------------------------'
End Sub
Yazablmek için aşağıdaki gibi yapalım
Kod:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
ActiveSheet.Unprotect "123"
On Error GoTo 10
With Range("C3:G150,J3:J150")
.Interior.ColorIndex = xlNone
.Locked = True
.FormulaHidden = True
End With
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
j.Locked = False
j.FormulaHidden = False
: GoTo 10
End If
End If: End If: Next
10:
ActiveSheet.Protect "123"
End Sub
 
Son düzenleme:
Üst