A sütununda dolu hücrede Entere basıldığında C sütunundaki hücreye 1 yazıp Enter yapsın

[Tevfik_Kursun]

Merhaba Arkadaşlar,
A sütununda dolu hücrede Entere basıldığında C sütunundaki hücreye 1 yazıp Enter yapsın. Bu konuya yardımcı olur musunuz, lütfen?
Saygılarımla

 

[Seyit Tiken]

Bu şekilde deneyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
Application.EnableEvents = False
If Target > 0 Then
Target.Offset(0, 2) = 1
End If
Application.EnableEvents = 1
End Sub

 

[Haluk]

İlgili sayfa modülüne;

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Column = 1 Then
        If Target <> "" Then
            Target.Offset(0, 2) = 1
            Target.Offset(1, 2).Select
        End If
    End If
End Sub

.

 

[Tevfik_Kursun]

Sayın Seyit ve Haluk Hocalarım,
İlgilerinize çok teşekkür ederim.
Saygılarımla

 

[Tevfik_Kursun]

Sayın Haluk Hocam,
Beklediğim A sütununda Enter yapıldığında C sütununda 1 yazıp bir sonraki işlevi yapacak. C de iken enter yapıldığında sonraki C hücresine de 1 yazıyor.
Sayın Seyit Hocam,
A sütununda Enter basıldığında C sütunundaki hücreyi boş geçti.
Saygılarımla

 

[Haluk]

Ben anlamadım doğrusu....

.

 

[Tevfik_Kursun]

Sayın Haluk Hocam,
Haklısınız, ben de yaptığınızı örnek hazırlarken anladım. A sütununda hücrede değişiklik olduğunda C deki hücreye 1 yazıyor.
Ben eksik söylemişim, özür dilerim. A sütununda 3000 kalem hazır yazılı. Kontrol için bu çalışma. A sütununda enter basıldığında c sütununda aynı hizaya 1 yazıp A sütununda 1 alt hücreye geçecek. Sadece A ve C sütunlarında korumayı kaldırdım, o nedenle aşağı inecek dememiştim. Tekrar özür dilerim. Ama problemimi çözerseniz sevinirim.
Seyit Hocamın çalışması da aynı şekilde çalışıyor. Seyit Hocamdan da özür diliyorum. Lütfen beni bağışlayın
Saygılarımla

 

[Haluk]

Bir de aşağıdaki makroyu çalıştırmayı deneyin.....

Sub Test()
    For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
        If Range("A" & i) <> "" Then Range("C" & i) = 1
    Next
End Sub

.

 

[Tevfik_Kursun]

Sayın Haluk Hocam,
Örnek ektedir. (Bir daha mutlaka önden örnek hazırlayacağım)
Saygılarımla

 

[Haluk]

8 No'lu mesajdaki kodu yeni ve boş bir modüle (sayfa modülü değil) yerleştirip, manuel çalıştırın..... ya da butona bağlayın.

Olmaz mı?

.

 

[Tevfik_Kursun]

Denedim Sayın Hocam,
A sütununda dolu hücrelerin karşısına gelen C sütunundaki hücrelerin hepsine birden 1 yazdı.
Saygılarımla

 

[Seyit Tiken]

Bence tasarım mantığıyla alakalı bir durum söz konusu. Birde bu şekilde deneyin.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
If Target = "" Then Exit Sub
If Target <> "" Then
Target.Offset(0, 2) = 1
End If
End Sub

 

[Korhan Ayhan]

İnceleyiniz.

 

[Tevfik_Kursun]

Sayın Seyit ve Korhan Hocalarım,
İlgilerinize çok teşekkür ederim.
Saygılarımla