Cursor Yönlendirmede Kod Düzeltme Yardımı

[baydeniro]

Arkadaşlar Merhaba. Ekteki dosyada bir Ders Programı düzenlemesi var. burada yapmak istediğimiz cursör yönlendirmede yardıma gereksinmemiz var.

1) DERS sayfasında veriler girildikçe 1 sağa kayması, D kolonunda Enter yapılınca 2 atlayıp F kolonuna gitmesi, F de enter yapılınca bir alttaki B kolonuna gitmesi.

2) PROGRAM sayfasında D kolonunda enter yapınca E gidiyordu. Sayfa isimlerini değiştirdik DERS sayfas A1 hücresine girtneye başladı. Bizim amacımız ise D kolonunda entera basınca F kolonuna gitmesi. Ve PROGAM sayfasında entera bastıkça cursörün sağa doğru kayması nasıl sağlanır.

Şimdiden teşekkürler.

 

[Necdet]

Merhaba,

DERS sayfasının kod bölümüne aşağıdaki kodları kopyalayınız.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Son
If Intersect(Target, [D:D, F:F]) Is Nothing Then Exit Sub
If Target.Column = 4 Then Target.Offset(0, 2).Select
If Target.Column = 6 Then Target.Offset(1, -4).Select
Son:
End Sub

Workbook Sayfasının Kodları :

Sub Workbook_Open()
    With Application
        .MoveAfterReturnDirection = xlToRight
    End With
End Sub

PROGRAM sayfasında ne yaptığınızı pek anlamadım, öneri getirmiyorum.

 

[baydeniro]

Sayın Necdet Yesertener yardımınız için çok teşekkürler. Ben sizlerin yardımı ile aşağıda bir kod oluşturdum. Bu kod A, B ve C kolonlarında entera basınca cursörün sağa gitmesini sağşlıyor, ama D kolonundan sonra aşağıdaki B kolonuna getirmiyor. Bunu nasıl sağlayabilirim ?


Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A:A, B:B, C:C]) Is Nothing Then Exit Sub
Target.Offset(0, 1).Select
If Intersect(Target, [D]) Is Nothing Then Exit Sub
Target.Offset(1, -4).Select
End Sub

 

[Necdet]

Sayın serdarokan,

Önceki mesajımda workbook sayfasındaki kod zaten Cursor'u sağa gitmesini ayarlıyordu, onu yapınca başka kodlara gerek yok.

Aşağıdaki kod yeterli, sadece D sütununu kontrol ediyor.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Son
If Intersect(Target, [D:D]) Is Nothing Then Exit Sub
If Target.Column = 4 Then Target.Offset(1, -2).Select
Son:
End Sub

 

[baydeniro]

sayın Necdet Yesertener, 2 özelliğ bir arada sağlamk mümkün mü. Yani A, B ve C de sağa gidecek, D de ise aşağı 2 sola gidecek !!!

 

[Necdet]

Aslında sizde yapabilirsiniz, olay basit.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Son
If Intersect(Target, [A: D]) Is Nothing Then Exit Sub
if Target.Column < 4 then Target.offset(0,1).select
If Target.Column = 4 Then Target.Offset(1, -2).Select
Son:
End Sub

 

[baydeniro]

Çok Teşekkürler

Sayın Necdet Yersertener, çok çok teşekkürler. Valla sizlerin bu sabırlı yaklaşımıyla bizim gibi amatörler de kod yazmayı öğrenecek ama daha yiyeceğimiz çok fırın ekemk var.

Bir de şu koda nasıl aşağıdaki özellikleri eklerim onu çözemedim. Buı kod biraz daha karmaşık. Cursör ayar kodları ana kodun içinde olduğu için bu kodu kendim yazamıyorum. Yapmak istediğim : A - B - C kolonlarında 1 sağa, D kolonunda 2 sağa, F kolonunda aşağıya 2 sola.


Private Sub Worksheet_Change(ByVal Target As Excel.Range)

If Not Intersect(Target, [B2:B65000]) Is Nothing Then
For sira = 2 To [B65000].End(3).Row
Range("A" & sira) = sira - 1
Next
Else

If Intersect(Target, [D265000]) Is Nothing Then GoTo ikincikod:

If InStr(1, Target.Address, ":") <> 0 Then Exit Sub
If Not IsEmpty(Target) Then
Cells(Target.Row, 1) = Target.Row - 1
Cells(Target.Row, 2) = IIf(Cells(Target.Row, 2) = "", Cells(Target.Row - 1, 2), Cells(Target.Row, 2))
Cells(Target.Row, 3) = IIf(Cells(Target.Row, 3) = "", Cells(Target.Row - 1, 3), Cells(Target.Row, 3))
Else
Cells(Target.Row, 1) = ""
Cells(Target.Row, 2) = ""
Cells(Target.Row, 3) = ""
End If

Application.ScreenUpdating = False
On Error Resume Next
If Intersect(Target, Range("D265000")) Is Nothing Then Exit Sub
sons = Sheets("FIYAT").Cells(65000, 1).End(xlUp).Row
aranan = Target.Value & Target.Offset(0, -1)
'Sheets("FIYAT").Select
For i = 1 To sons
bul = Sheets("FIYAT").Cells(i, 2) & Sheets("FIYAT").Cells(i, 3)
If bul = aranan Then

adres = Sheets("FIYAT").Cells(i, 2).Row
Target.Offset(0, 1) = Sheets("FIYAT").Cells(adres, 4)

End If
Next

End If

Exit Sub

ikincikod:
If Intersect(Target, [F:F]) Is Nothing Then Exit Sub
Target.Offset(0, 1) = Target * Target.Offset(0, -1)
Target.Offset(1, -2).Select

End Sub

 

[Seyit Tiken]

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column < 4 Then Target.Offset(, 1).Select
If Target.Column = 4 Then Target.Offset(, 2).Select
If Target.Column = 6 Then Target.Offset(1, -2).Select
End Sub

Şeklinde deneyiniz.

 

[baydeniro]

Çok Teşekkürler

Sayın Seyit Tiken ve Sayın Necdet Yesertener, çok çok teşekkürler. Zaman ayırıp yardımcı olduğunuz için. Elleriniz dert görmesin. Sayenizde sorunumu çözdüğüm gibi, kendimi geliştiriyorum. Başarılarınızın devamını dilerim.