Satır Değiştirince Çalışacak Makro

[orrhankaya]

Seçili satırdaki bilgilerin listelendiği bir form var. Formun yüklenmesi birkaç saniye sürüyor. Çalışmam olumsuz etkilleniyor. Bu amaçla; Sütun değiştirirken (Örneğin A5 hücresinden B5 hücresine geçerken) çalışmasın. Ancak Satır değiştirirken (Örneğin A5 hücresinden A6 hücresine geçerken) çalışşan bir makro oluşturmak istiyorum.


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Satır değiştirince çalışan ama Sütun değiştirince çalışmayan Makro
End Sub

 

[Seyit Tiken]

Aşağıdaki kodu deneyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$5" Then MsgBox "Bu mesajın yerine kodunuzu yazın"
End Sub

 

[orrhankaya]

Sayın Seyit Tiken
Sanırım konuyu tam olarak anlatamadım.
Hücrede işlem yaptığımda değil seçimi değiştirdiğimde çalışacak.
Seçimi herhangi bir satırın sütunları arasında değiştirince değil,
Seçimi herhangi bir sütunun satırları arasında değiştirince çalışacak.
Aşağıdaki şekilde yapıyorum. ama olmuyor.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
a = ActiveCell.Column
If Target.Column > a Then MsgBox "aaaaaaaaaa"
End Sub

 

[Levent Menteşoğlu]

Çalışmasını istediğiniz hücre aralığı nedir?

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz. Sadece A sütunundaki hücre değişimlerinde kod çalışacaktır.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Intersect(Target, [A:A]) Is Nothing Then Exit Sub
    'ÇALIŞACAK KODLARINIZ.
End Sub

 

[orrhankaya]

Sayın Leventm
Çalışma aralığım Çok geniş bir alan A2:FF65000 diyebiliriz

 

[Levent Menteşoğlu]

Benim kasdettiğim seçilince userformun açılacağı hücre aralığı idi.

 

[orrhankaya]

Öğrenci devamsızlıkları ve öğrenci notları yaklaşık 150 sütundaki bilgiler forma yükleniyor.
Ayrıca Seçimin değiştirilmesiyle birlikte aktive satır (Activecell.Row) da biçimleniyor. Bu da çalışmamı yavaşlatıyor. Satır değiştirirken yavaşlatsın ama aynı satırın sütunları arasında dolaşırken makronun çalışması gerekmiyor.

 

[Korhan Ayhan]

Selamlar,

Kullandığınız kodu eklermisiniz.

 

[orrhankaya]

Kullandığım Kod:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
Cells.FormatConditions.Delete
If Intersect(ActiveCell, [A2:CL2000]) Is Nothing Then Exit Sub
Range("A" & ActiveCell.Row & ":CL" & ActiveCell.Row).FormatConditions.Add Type:=xlExpression, Formula1:=1
Range("A" & ActiveCell.Row & ":CL" & ActiveCell.Row).FormatConditions(1).Interior.ColorIndex = 20
Range("A" & ActiveCell.Row & ":CL" & ActiveCell.Row).FormatConditions(1).Font.Bold = True
Range("A" & ActiveCell.Row & ":CL" & ActiveCell.Row).FormatConditions(1).Font.ColorIndex = 5
ActiveCell.FormatConditions.Add Type:=xlExpression, Formula1:=1
ActiveCell.FormatConditions(1).Interior.ColorIndex = 8

a = ActiveCell.Row
kayitformu.sn5.Value = Cells(a, 1).Value
kayitformu.sb5.Value = Cells(a, 2).Value
kayitformu.no5.Value = Cells(a, 3).Value
kayitformu.isim5.Value = Cells(a, 4).Value
kayitformu.cins5.Value = Cells(a, 5).Value
kayitformu.dvm5.Value = Cells(a, 6).Value
kayitformu.tc5.Value = Cells(a, 7).Value
kayitformu.baba5.Value = Cells(a, 8).Value
kayitformu.ana5.Value = Cells(a, 9).Value
kayitformu.yeri5.Value = Cells(a, 10).Value
kayitformu.tarih5.Value = Cells(a, 11).Value
kayitformu.adres5.Value = Cells(a, 12).Value
kayitformu.telefon5.Value = Cells(a, 13).Value
kayitformu.kulup5.Value = Cells(a, 15).Value
kayitformu.notdort.Value = Cells(a, 127).Value
kayitformu.notbes.Value = Cells(a, 128).Value
kayitformu.notalti.Value = Cells(a, 129).Value
kayitformu.notyedi.Value = Cells(a, 130).Value
kayitformu.dv1.Value = Cells(a, 17).Value
kayitformu.dv2.Value = Cells(a, 18).Value
kayitformu.dv3.Value = Cells(a, 19).Value
kayitformu.dv4.Value = Cells(a, 20).Value
kayitformu.dv5.Value = Cells(a, 21).Value
kayitformu.dv6.Value = Cells(a, 22).Value
kayitformu.dv7.Value = Cells(a, 23).Value
kayitformu.dv8.Value = Cells(a, 24).Value
kayitformu.dv9.Value = Cells(a, 25).Value
kayitformu.dv10.Value = Cells(a, 26).Value
kayitformu.dv11.Value = Cells(a, 27).Value
kayitformu.dv12.Value = Cells(a, 28).Value
kayitformu.dv13.Value = Cells(a, 29).Value
kayitformu.dv14.Value = Cells(a, 30).Value
kayitformu.dv15.Value = Cells(a, 31).Value
kayitformu.dv16.Value = Cells(a, 32).Value
kayitformu.dv17.Value = Cells(a, 33).Value
kayitformu.dv18.Value = Cells(a, 34).Value
kayitformu.dv19.Value = Cells(a, 35).Value
kayitformu.dv20.Value = Cells(a, 36).Value
kayitformu.dv21.Value = Cells(a, 37).Value
kayitformu.dv22.Value = Cells(a, 38).Value
kayitformu.dv23.Value = Cells(a, 39).Value
kayitformu.dv24.Value = Cells(a, 40).Value
kayitformu.dv25.Value = Cells(a, 41).Value
kayitformu.dv26.Value = Cells(a, 42).Value
kayitformu.dv27.Value = Cells(a, 43).Value
kayitformu.dv28.Value = Cells(a, 44).Value
kayitformu.dv29.Value = Cells(a, 45).Value
kayitformu.dv30.Value = Cells(a, 46).Value
kayitformu.dv31.Value = Cells(a, 47).Value
kayitformu.dv32.Value = Cells(a, 48).Value
kayitformu.dv33.Value = Cells(a, 49).Value
kayitformu.dv34.Value = Cells(a, 50).Value
kayitformu.dv35.Value = Cells(a, 51).Value
kayitformu.dv36.Value = Cells(a, 52).Value
kayitformu.dv37.Value = Cells(a, 53).Value
kayitformu.dv38.Value = Cells(a, 54).Value
kayitformu.dv39.Value = Cells(a, 55).Value
kayitformu.dv40.Value = Cells(a, 56).Value
kayitformu.nt1.Value = Cells(a, 57).Value
kayitformu.nt2.Value = Cells(a, 58).Value
kayitformu.nt3.Value = Cells(a, 59).Value
kayitformu.nt4.Value = Cells(a, 60).Value
kayitformu.nt5.Value = Cells(a, 61).Value
kayitformu.nt7.Value = Cells(a, 62).Value
kayitformu.nt8.Value = Cells(a, 63).Value
kayitformu.nt9.Value = Cells(a, 64).Value
kayitformu.nt10.Value = Cells(a, 65).Value
kayitformu.nt11.Value = Cells(a, 66).Value
kayitformu.nt12.Value = Cells(a, 67).Value
kayitformu.nt13.Value = Cells(a, 68).Value
kayitformu.nt14.Value = Cells(a, 69).Value
kayitformu.nt15.Value = Cells(a, 70).Value
kayitformu.nt16.Value = Cells(a, 71).Value
kayitformu.nt17.Value = Cells(a, 72).Value
kayitformu.nt18.Value = Cells(a, 73).Value
kayitformu.nt19.Value = Cells(a, 74).Value
kayitformu.nt20.Value = Cells(a, 75).Value
kayitformu.nt21.Value = Cells(a, 76).Value
kayitformu.nt22.Value = Cells(a, 77).Value
kayitformu.nt24.Value = Cells(a, 78).Value
kayitformu.nt25.Value = Cells(a, 79).Value
kayitformu.nt26.Value = Cells(a, 80).Value
kayitformu.nt27.Value = Cells(a, 81).Value
kayitformu.nt28.Value = Cells(a, 82).Value
kayitformu.nt29.Value = Cells(a, 83).Value
kayitformu.nt30.Value = Cells(a, 84).Value
kayitformu.nt31.Value = Cells(a, 85).Value
kayitformu.nt32.Value = Cells(a, 86).Value
kayitformu.nt33.Value = Cells(a, 87).Value
kayitformu.nt34.Value = Cells(a, 88).Value

End Sub

 

[Korhan Ayhan]

Selamlar,

Kodunuzu aşağıdaki şekilde değiştirip denermisiniz.

Not : Kod hatalı olduğu için tarafımdan silinmiştir.

 

[orrhankaya]

Sayın Korhan
Dün gece pek uğraşamadım. Bugün son gönderdiğiniz kodları inceledim çalıştıramadım.
"Sütun = Target.Column" kodunun ve "If ActiveCell.Column = C Then Exit Sub" kondunun işlevini anlamayamadım.

 

[Korhan Ayhan]

Selamlar,

Özür dilerim yanlış yönlendirdim. Dosyanızı ekleyebilirmisiniz.

 

[orrhankaya]

Satır Diğiştirice Çalışan Makro

Dosyam Çok büyük olduğundan kısa bir örnek dosya gönderiyorum

 

[Korhan Ayhan]

Selamlar,

Anladığım kadarıyla ekte örnek bir dosya hazırladım. İncelermisiniz.

 

[orrhankaya]

Teşekkür ederim Sayın Korhan,
Çözümünüzü burada herkesle paylaşmak istiyorum.


Dim EskiSatır

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If ActiveCell.Row = EskiSatır Then Exit Sub
EskiSatır = Target.Row
MsgBox ("Satır değiştirdiniz")
End Sub