Öğrenci Devamsızlıklarını işaretleme

[orrhankaya]

Belirtilen numaradaki öğrencinin belirtilen tarihin hizasını işaretlemek için elimde bulunan kod sorunsuz çalışıyor. Bu kodu 20 kez kullanarak aynı anda 20 Devamsız öğrenci girişi yapıyorum.


Sub Bul()
Sheets("Sayfa1").Select
If Sheets("Sayfa2").[A1] = "" Then GoTo Boş
Columns("C:C").Find(What:=Sheets("Sayfa2").[A1], LookAt:=xlWhole).Activate
a = ActiveCell.Row
Rows("1:1").Find(What:=Sheets("Sayfa2").[A2], LookAt:=xlWhole).Activate
b = ActiveCell.Column
Cells(a, b).Value = "X"
Boş:
End Sub


Okul 180 İşgünü açık olduğundan 180 sütun kullanmak yerine başka bir çözüm bulunamaz mı?
İlgilenenlere şimdiden teşekkürler

 

[orrhankaya]

Satırlarda Öğrenci İsimleri ve sütunlarda işgünü tarihlerini içeren bir dosya gönderiyorum

 

[sefer seferoğlu]

Dosyanız düzenlemeye karşı korumalı korumayı kaldırıp tekrar yollarsanız ilgilenen arkadaşlar daha kolay yardımcı olabilir.
İyi günler...

 

[orrhankaya]

Dosyanız düzenlemeye karşı korumalı ...........

Dosyayı tekrar indirip kontrol ettim Koruma Sayfada da yok VBA kısmında da yok. Ne demek istediğinizi anlıyamadım

 

[Levent Menteşoğlu]

Okul 180 İşgünü açık olduğundan 180 sütun kullanmak yerine başka bir çözüm bulunamaz mı?

Hergün için ayrı sütun düzenlemeden devamsızlık yapan öğrencinin adının yanındaki ilk boş sütuna başlangıç tarihi bir sonrakine de bitiş tarihi yazılsa nasıl olurdu. Her devamsızlıkta ilk boş sütundan kayıt devam ederdi.

 

[orrhankaya]

. Her devamsızlıkta ilk boş sütundan kayıt devam ederdi.

Başka bir çözüm derken aslında ben bunu kastediyordum. Zaten 180 sütunu kullanarak bu işi yapıyorum.

 

[Levent Menteşoğlu]

Peki bu devamsızlık bilgilerini nasıl giriyorsunuz, bir sayfamı yoksa userform üzerindenmi?

 

[orrhankaya]

Userform'dan giriyorum. Dosyayı gönderiyorum

 

[orrhankaya]

Uğraştım aşağıdaki kodu oluşturdum. İşimi görüyor. Herkese en içten teşekkürlerimi iletiyorum

Sub Bul()
Sheets("Kütük").Select
If Sheets("Sayfa2").[A1] = "" Then GoTo Boş
On Error GoTo hata
Columns("C:C").Find(What:=Sheets("Sayfa2").[A1], LookAt:=xlWhole).Activate 'Numarasını bulur
ActiveCell.Offset(0, 14).Select 'İlk 14 Sütunu atlar
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(0, 1).Select 'Sağdaki ilk boş hücreye gider
Loop
ActiveCell.Value = Sheets("Sayfa2").[A2] 'Devamsızlık tarihini yazar
hata:
If Err = 91 Then
MsgBox ("Birinci Numara bulunamadı.")
End If
Boş:
End Sub