Çözüldü Boş bırakılan sorulardaki hata kontrolü

klop01 · 11 Mart 2019

Bir sınıftaki öğrencilere puan yazarken boş bırakılan soruların olup olmadığını denetlemek amacı bir makro ile ilgili yardımlarınızı rica ediyorum.
http://s2.dosya.tc/server7/fzbgud/HATA_KONTROLU.rar.html

Ömer BARAN · 12 Mart 2019

Merhaba.
Aşağıdaki kod blokunu boş bir MODULE yapıştırın ve sayfadaki şekil ile bu kodu ilişkilendirin.
-- Belgenizde belirtilen 2580 sayısı yerine, D sütununa yazılan ÖĞRENCİ SAYISI * (E5:AM5 aralığındaki sayı adeti + 8) işleminin sonucuna bakılıyor.
-- 5'inci satırda not değeri alanı BOŞ mu kontrolü var.
-- 5'inci satırdaki not yazılmış sütunlar dışında olup, öğrenci satırlarında veri varsa bu alanın silinmesi işlemi var.
-- İşlem sonuçları öğrenci satırında AW sütununa yazılır.

CSS:

Sub HATA_KONTROL_BRN()
Set s = ActiveSheet
sonsat = s.Cells(Rows.Count, "D").End(3).Row
soruadet = 35 - WorksheetFunction.CountBlank([E5:AM5])
If soruadet = 0 Then
    MsgBox "İşleme başlanması için önce soruların puan değerleri yazılmalıdır !", vbCritical
    Exit Sub
End If
s.[AW:AW].ClearContents
alan1 = s.Range(s.[E7], s.Cells(sonsat, soruadet + 4)).Address(0, 0)
alan2 = s.Range(s.[AO7], s.Cells(sonsat, "AV")).Address(0, 0)
adet1 = s.Range(alan1).Count: adet2 = s.Range(alan2).Count
If soruadet > 0 And soruadet < 35 And _
    WorksheetFunction.CountIf(s.Range(s.Cells(7, soruadet + 5), s.Cells(sonsat, "AM")), "<>") > 0 Then
    cvp = MsgBox( _
        "Soru sütunları dışında kalan alanın boş olması gerekir." & vbCrLf & _
        s.Range(s.Cells(7, soruadet + 5), s.Cells(sonsat, "AM")).Address(0, 0) & _
        " alanındaki veriler silinsin mi ??", vbYesNo + vbQuestion)
    Select Case cvp
        Case vbYes: s.Range(s.Cells(7, soruadet + 5), s.Cells(sonsat, "AM")).ClearContents
        Case Else
            MsgBox "Boş olması gereken" & vbCrLf & _
                    s.Range(s.Cells(7, soruadet + 5), s.Cells(sonsat, "AM")).Address(0, 0) _
                    & " alanı boşaltılmadan" & vbCrLf & "HATA KONTROLÜ YAPILAMAZ !", vbCritical
                Exit Sub
    End Select
End If
If adet1 + adet2 = WorksheetFunction.CountBlank(s.Range(alan1)) + _
                WorksheetFunction.CountBlank(s.Range(alan2)) Then
    MsgBox "Henüz puan yazmadınız !" & vbLf & adet1 + adet2 & " adet hücre boş !", vbCritical
Else
    For sat = 7 To sonsat
        If WorksheetFunction.CountBlank(s.Range(s.Cells(sat, "E"), s.Cells(sat, soruadet + 4))) = 0 Then
            s.Cells(sat, "AW") = "EKSİK BİLGİ YOK"
        ElseIf WorksheetFunction.CountBlank(s.Range(s.Cells(sat, "E"), s.Cells(sat, soruadet + 4))) = soruadet Then
            s.Cells(sat, "AW") = "CEVAP YOK"
        ElseIf WorksheetFunction.CountBlank(s.Range(s.Cells(sat, "E"), s.Cells(sat, soruadet + 4))) <> soruadet Then
            s.Cells(sat, "AW") = "HATA VAR !"
        End If
    Next
End If
MsgBox "KONTROL TAMAMLANDI." & vbLf & "Kontrol sonuçları AW sütununda.", vbInformation, "..:: Ömer BARAN ::.."
End Sub

klop01 · 12 Mart 2019

Ömer Bey,
Cevabımın başlangıcında hazırlamış olduğunuz ayrıntılı makro için çok teşekkürlerimi sunuyorum, çok sağ olunuz.

Oluşan durumu şöyle özetleyeyim:
Siz istenilenlerin ötesinde, emek harcayarak tam bir hata denetimi önerisinde bulunmuşsunuz. Satır bazlı sonuçların AW sütununa yazılması. Hücre konumlarının belirtilmesi. Ayrıntılı şekildeki bu makro benim için ihtiyaç fazlası durumda.

İhtiyacım olan makro şu işlemleri yapsa dosyama göre tam sonuç alıyorum.
1. Makro önce şunu yapsın: E7:AM66 ve AO7:AV66 aralıklarına baksın tamamen boşsa(2580 adet hücre var.) Mesaj: "Henüz puan yazmadınız!"
2. E7:AM66 arasındaki satırlarda yer alan dolu hücre sayısı ile E5:AM5 satırındaki dolu hücre sayısı eşit değil ise Mesaj: "Hata var!"
Diğer her durumda Mesaj: "Hata yok!" Mesajda hücre konumu göstermeye gerek yok.
ÖRNEK:
E7:AM7 ile E5:AM5 aralıklarında dolu hücre sayıları eşit mi?
E8:AM8 ile E5:AM5 aralıklarında dolu hücre sayıları eşit mi?
E9:AM9 ile E5:AM5 aralıklarında dolu hücre sayıları eşit mi?
.
.
.
E66:AM66 ile E5:AM5 aralıklarında dolu hücre sayıları eşit mi? Bir tanesinde bile eşit değilse "Hata var." diğer durumlarda "Hata yok."
3. Makro aktif sayfa için ayarlanabilir mi? Aynı yapıda birden fazla sayfada işlem yapmam gerekli.

Konunun özeti:
20 soruluk bir sınav yapıldı. Bir öğrenciye 19 soruda puanlama yapıldı. Bir soru gözden kaçarak boş bırakıldı ve değerlendirme dışı kaldı. Sadece bu hatayı yakalamaya çalışıyorum.

veyselemre · 12 Mart 2019

Kod:

Sub degerlendirmeKontrol()
    If WorksheetFunction.Count(Range("E7:AM66,AO7:AV66")) = 0 Then
        msg = "Henüz Değerlendirme Yapılmamış"
        GoTo cikis
    End If
    soruSay = WorksheetFunction.CountA(Range("E5:AM5"))
    For i = 7 To Cells(Rows.Count, 4).End(3).Row
        satSay = WorksheetFunction.CountA(Range("E" & i & ":AM" & i))
        If satSay <> soruSay Then
            msg = msg & i & ".Satır Hatalı" & vbCr
            hatali = True
        End If
    Next i
cikis:
    If hatali = False Then msg = "Değerlendirme Hatasız Yapılmıştır"
    MsgBox msg
End Sub

klop01 · 12 Mart 2019

Veysel Bey,
Kod için teşekkürler.

Şu sorunlar oluştu:
>>> E7:AM66 ve AO7:AV66 aralıkları tamamen boş iken "Henüz Değerlendirme Yapılmamış" mesajı yerine "Değerlendirme Hatasız Yapılmıştır" mesajını veriyor.
>>> E7:AM66 arasındaki satırlarda yer alan dolu hücre sayısı ile E5:AM5 satırındaki dolu hücre sayısı eşit ise hata göstermiyor, bu doğru.
Fakat tüm satırı boş olanları da hata gösteriyor ve listeliyor.
E7:AM66 arasındaki satırlarda yer alan dolu hücre sayısı ile E5:AM5 satırındaki dolu hücre sayısı eşit değilse hata sonucu çıkmalı, diğer durumlarda doğru.
>>> Gerek yoktu ama hatalı satır numaralarını mesajda göstermişsiniz. Hata kutucuğu çıkınca 7. satırdan başlayarak listeleme yapıyor. Burası şöyle değiştirilebilirse kullanılabilir.

Örnek: 7. satırda hata varsa "7. satır hatalı" yerine "1. öğrencinin puanında hata var." Çünkü 1. öğrenci 7. satırdan başlıyor.

Ömer BARAN · 12 Mart 2019

Önceki cevabımda küçük hatalar gördüm ve onları düzelttim.
Ayrıca kod'un aktif sayfada çalışması için değişiklik de yaptım.
Sayfayı yenileyerek önceki cevabıma tekrar bakınız.

klop01 · 12 Mart 2019

Teşekkürler.
Verdiğiniz kod farklı durumları da işin içine alan bayağı kapsamlı bir kod fakat benim ihtiyacım daha basit.
3. iletimdeki iki durumu karşılayan bir kod olması yeterli.
Vaktiniz varsa, ilgilenmek isterseniz 3. iletimdeki gibi bir kod talabim vardır.

veyselemre · 13 Mart 2019

Kod:

Sub degerlendirmeKontrol()
    If WorksheetFunction.Count(Range("E7:AM66,AO7:AV66")) = 0 Then
        msg = "Henüz Değerlendirme Yapılmamış"
        hatali = True
        GoTo cikis
    End If
    soruSay = WorksheetFunction.CountA(Range("E5:AM5"))
    For i = 7 To Cells(Rows.Count, 4).End(3).Row
        satSay = WorksheetFunction.CountA(Range("E" & i & ":AM" & i))
        If satSay <> soruSay And satSay <> 0 Then
            msg = msg & i - 6 & ".öğrencinin puanında hata var." & vbCr
            hatali = True
        End If
    Next i
cikis:
    If hatali = False Then msg = "Değerlendirme Hatasız Yapılmıştır"
    MsgBox msg
End Sub

klop01 · 13 Mart 2019

Sayın veyselemre,
Kod işlemi tam olarak yaptı. Çok teşekkürler.

klop01 · 22 Mart 2019

Veysel Bey,
8 no.lu iletide verdiğiniz kod hatasız çalışmakta.
Kodda geçen aşağıdaki uyarıda puanları hatalı öğrenciler alt alta listeleniyor.
msg = msg & i - 6 & ".öğrencinin puanında hata var." & vbCr

Sadece bu uyarıda geçerli olmak üzere(kod içerisinde üç tane uyarı var.) uyarının üst satırına "Öğrenci sorudan puan alamadı ise ilgili soru için SIFIR yazmalısınız." bilgisini eklemek istiyorum.

Örnekle gösterirsek:
Öğrenci sorudan puan alamadı ise ilgili soru için SIFIR yazmalısınız.
4. öğrencinin puanında hata var.
7. öğrencinin puanında hata var.
9. öğrencinin puanında hata var.

>>> Bahsettiğim eklemeyi kırmızı ile gösterdiğim uyarının önüne ekleyince eklediğim yeri hatalı öğrenci sayısı kadar çoğaltıyor.
>>> Verdiğiniz kodun sonundaki
MsgBox msg
kısmına ekleyince eklenen kısım koddaki diğer uyarı pencerelerinde de gözüküyor.

Konu ile ilgili bir şey yapılabilirse paylaşır mısınız?

veyselemre · 22 Mart 2019

Kod:

Sub degerlendirmeKontrol()
    If WorksheetFunction.Count(Range("E7:AM66,AO7:AV66")) = 0 Then
        msg = "Henüz Değerlendirme Yapılmamış"
        hatali = True
        GoTo cikis
    End If
    soruSay = WorksheetFunction.CountA(Range("E5:AM5"))
    For i = 7 To Cells(Rows.Count, 4).End(3).Row
        satSay = WorksheetFunction.CountA(Range("E" & i & ":AM" & i))
        If satSay <> soruSay And satSay <> 0 Then
            msg = msg & i - 6 & ".öğrencinin puanında hata var." & vbCr
            hatali = True
        End If
    Next i
    If hatali Then msg = "Öğrenci sorudan puan alamadı ise ilgili soru için SIFIR yazmalısınız." & vbCr & msg
cikis:
    If hatali = False Then msg = "Değerlendirme Hatasız Yapılmıştır"
    MsgBox msg
End Sub

klop01 · 22 Mart 2019

Tekrar teşekkür ederim.
İfade ettiğim konu çözülmüştür.

klop01 · 13 Şubat 2021

Arkadaşlar,
11. iletide sayın veyselemre'nin gönderdiği aşağıdaki kod sorunu tam olarak çözmüştü.

Kod:

Sub degerlendirmeKontrol()
    If WorksheetFunction.Count(Range("E7:AM66,AO7:AV66")) = 0 Then
        msg = "Henüz Değerlendirme Yapılmamış"
        hatali = True
        GoTo cikis
    End If
    soruSay = WorksheetFunction.CountA(Range("E5:AM5"))
    For i = 7 To Cells(Rows.Count, 4).End(3).Row
        satSay = WorksheetFunction.CountA(Range("E" & i & ":AM" & i))
        If satSay <> soruSay And satSay <> 0 Then
            msg = msg & i - 6 & ".öğrencinin puanında hata var." & vbCr
            hatali = True
        End If
    Next i
    If hatali Then msg = "Öğrenci sorudan puan alamadı ise ilgili soru için SIFIR yazmalısınız." & vbCr & msg
cikis:
    If hatali = False Then msg = "Değerlendirme Hatasız Yapılmıştır"
    MsgBox msg
End Sub

Bu kod E7:AM66 arasında kontrol yapmalı. Sonradan fark ettiğim durum şu: Kod 66. satırın devamında da gördüğü değerleri işleme tabi tutuyor.
Acaba aşağıdaki satırdaki E ve AM sütunlarının tamamını mı görüyor?
satSay = WorksheetFunction.CountA(Range("E" & i & ":AM" & i))
Bu kodu 66. satırı geçmeyecek şekilde sınırlayabiliriz mi?
Ekteki belgedeki butona tıklandığında ortaya çıkan durum görülebilir.

Korhan Ayhan · 14 Şubat 2021

Merhaba,

Kodun bu bölümünü;

For i = 7 To Cells(Rows.Count, 4).End(3).Row

Aşağıdaki gibi değiştirip deneyiniz.

For i = 7 To 66

klop01 · 14 Şubat 2021

Korhan Ayhan,
Değişimi yapınca aşağıdaki hata ortaya çıktı:

Korhan Ayhan · 14 Şubat 2021

Mesajımı dikkatli okuyunuz..

klop01 · 14 Şubat 2021

Evet, yanlış anlama oldu. Sorun düzeldi.
Teşekkür ederim. Sağ olun.

Çözüldü Boş bırakılan sorulardaki hata kontrolü

klop01

Ekli dosyalar

Ömer BARAN

Uzman

klop01

veyselemre

Özel Üye

klop01

Ömer BARAN

Uzman

klop01

veyselemre

Özel Üye

klop01

klop01

veyselemre

Özel Üye

klop01

klop01

Ekli dosyalar

Korhan Ayhan

Administrator

klop01

Korhan Ayhan

Administrator

klop01