• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Hücreler boş ise geçilmesin

Katılım
15 Temmuz 2012
Mesajlar
2,802
Excel Vers. ve Dili
Ofis 2021 TR 64 Bit
Merhaba herkese hayırlı akşamlar.

Ekte gönderdiğim excel dosyamın Sayfa1'de B7 ile H56 arasında bilgi girişi olmaktadır.

Yapmak istediğim hücreler yan yana yazılırken bir önceki hücre boş ise uyarı versin ve ilgili hücreye veri girişi olmasın.

Bir kaç örnek buldum ancak kendi dosyama uyarlıyamadım.

Yardımcı olur musunuz?
 

Ekli dosyalar

Merhaba,
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Intersect(Range("B7:H56"), Target) Is Nothing Then Exit Sub

r = Target.Row
c = Target.Column
If WorksheetFunction.CountBlank(Range(Cells(r, 2), Cells(r, c))) > 1 Then

MsgBox "Bu hücreyi seçemezsiniz."
Cells(r, 2).Select
End If
End Sub

Kod işinizi görür mü?
 
Sayın Muhammet Bey, ellerinize sağlık kod gayet güzel çalışıyor.

Örneğin 1.satırda veri aralığındaki her hangi bir hücreye yazmaya çalıştığım zaman, imleç o satırdaki boş bırakılan hücreye gitse, bu şekilde yapabilir misiniz?
 
Tıkladığınız hücre boş ise, o satırdaki en soldaki boş hücreye gider
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Intersect(Range("B7:H56"), Target) Is Nothing Then Exit Sub

r = Target.Row
c = Target.Column
If WorksheetFunction.CountBlank(Range(Cells(r, 2), Cells(r, c))) > 1 Then

MsgBox "Bu hücreyi seçemezsiniz."
d = WorksheetFunction.CountA(Range("B" & r & ":H" & r)) + 2
Cells(r, d).Select
End If
End Sub
 
Allah razı olsun, çok teşekkür ediyorum, tam istediğim gibi oldu.

Hayırlı akşamlar diliyorum.
 
Sayın Muhammet Bey, kusura bakmayın tekrar rahatsız ediyorum, hayırlı akşamlar.

Konu aynı olduğu için tekrar konu açmadım.
4.mesajınızdaki kod gayet güzel çalışıyor, bu kod aynı satırdakiler için çok güzel çalışıyor.

Yeni bir istek meydana geldi, yapmak istediğim N8 ile N20 arasında da aynı işlemi yapmak istedim, kodu uyarlamaya çalıştım ancak başaramadım.

Yardımcı olur musunuz?
 
Bilgisayar şimdi yanimda değil. Sonra bakayım veya gruptaki arkadaşlar da cevap verebilirler.
 
İlginiz için çok teşekkür ediyorum Muhammet Bey.
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Intersect(Range("N8:N20"), Target) Is Nothing Then Exit Sub

r = Target.Row

If WorksheetFunction.CountBlank(Range("N8:N" & r)) > 1 Then

MsgBox "Bu hücreyi seçemezsiniz."
d = WorksheetFunction.CountA(Range("N8:N" & r)) + 8
Cells(d, 14).Select
End If
End Sub

Kodu deneyiniz.
 
Sayın Muhammet Bey, ellerinize sağlık kod tek başına gayet güzel çalışıyor.

Ekte gönderdiğim excel dosyamdaki İZİN sayfasında başka kodlarla birlikte olunca çalışmıyor.

Bi bakabilir misiniz?
 

Ekli dosyalar

Sayın Muhammet Bey, hücreleri açtığım halde yine çalışmadı.
Hücreler birleşik halde sizin kodları en üste aldığım zaman sizin kodlar çalışıyor, birleştirilmiş hücrede çalışmıyor, bu seferde diğer bu hücrede formül var kodları çalışmıyor.
 
Son düzenleme:
Sayın Muhammet Bey, birleştirilmiş hücreleri de çözdüm, sayfayı tekrar ayarladım.

Sayfadaki 3 kod birden çalışmıyor. 3 kodu birden çalıştırmak için ne yapmak gerekiyor, yardımcı olur musunuz?
 

Ekli dosyalar

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
For Each Item In Selection
If Mid(Item.Formula, 1, 1) = "=" Then
MsgBox "Bu hücrede formül var, silmeyin ! . .", vbInformation, "A S L A N"
Range("N8").Activate
End If
Next


If Intersect(Range("N8:N14"), Target) Is Nothing Then GoTo 10
r = Target.Row
If WorksheetFunction.CountBlank(Range("N8:N" & r)) > 1 Then
MsgBox "Bir önceki hücreyi boş bıraktınız.", vbInformation, "A S L A N"
d = WorksheetFunction.CountA(Range("N8:N" & r)) + 8
Cells(d, 14).Select
Exit Sub
End If

10
If Intersect(Range("N10"), Target) Is Nothing Then GoTo 20
Cancel = True
takvim.Show
If tarih <> Empty Then
Target = CDate(tarih)
End If
20

End Sub

Kodu deneyiniz.
 
Sayın Muhammet Bey, ellerinize sağlık çok teşekkür ederim, Allah razı olsun tam istediğim gibi çalışıyor.

Hayırlı çalışmalar, hayırlı günler diliyorum.
 
Geri
Üst