Kitapçık türüne göre cevap anahtarı kontrolü

[bhdr]

Herkese merhaba;

Ek' te göndermiş olduğum dosya içerisindeki sayda 1 de öğrencilerin sorulara işaretlemiş oldukları şıklar sayfa 2 de ise cevap anahtarı var.

Bunları kitapçık ayrımı olmadan kod ile doğru yanlış ayrımı yapabiliyorum.Ancak şimdi kitapçık türüne göre cevapları kontrol etmem lazım.Bunun için kod döngüsünü nasıl değiştirmeliyim ?

Teşekkürler.

 

[hoguz2]

dosyanızı dis baglantidan da paylasabilir misiniz...

 

[bhdr]

http://s5.dosya.tc/server5/glnzvn/Kitap1.zip.html

 

[askm]

Sub askm()
Dim s1, s2 As Worksheet
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
Dim Son1 As Long
Application.ScreenUpdating = False
Son1 = s1.Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To Son1
    Dogru = 0
    Yanlis = 0
    Bos = 0
        If s1.Cells(i, 2) = "a" Then
            Satir = 2
        ElseIf s1.Cells(i, 2) = "b" Then
            Satir = 2
        End If
        For x = 3 To 7
            If s1.Cells(i, x) <> Empty Then
                If s1.Cells(i, x) = s2.Cells(Satir, x - 1) Then
                    Dogru = Dogru + 1
                Else
                    Yanlis = Yanlis + 1
                End If
            Else
                Bos = Bos + 1
            End If
        Next x
s1.Cells(i, 8) = Dogru
s1.Cells(i, 9) = Yanlis
s1.Cells(i, 10) = Bos
Next i
Application.ScreenUpdating = True
MsgBox "İşlem tamam...", vbInformation, "ASKM"
End Sub

 

[bhdr]

Sub askm()
Dim s1, s2 As Worksheet
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
Dim Son1 As Long
Application.ScreenUpdating = False
Son1 = s1.Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To Son1
    Dogru = 0
    Yanlis = 0
    Bos = 0
        If s1.Cells(i, 2) = "a" Then
            Satir = 2
        ElseIf s1.Cells(i, 2) = "b" Then
            Satir = 2
        End If
        For x = 3 To 7
            If s1.Cells(i, x) <> Empty Then
                If s1.Cells(i, x) = s2.Cells(Satir, x - 1) Then
                    Dogru = Dogru + 1
                Else
                    Yanlis = Yanlis + 1
                End If
            Else
                Bos = Bos + 1
            End If
        Next x
s1.Cells(i, 8) = Dogru
s1.Cells(i, 9) = Yanlis
s1.Cells(i, 10) = Bos
Next i
Application.ScreenUpdating = True
MsgBox "İşlem tamam...", vbInformation, "ASKM"
End Sub

Teşekkürler ancak kitapçık türlerinden birini değiştirip tekrar hesaplattığımda sonuç değişmiyor.

 

[askm]

Sub askm()
Dim s1, s2 As Worksheet
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
Dim Son1 As Long
Application.ScreenUpdating = False
Son1 = s1.Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To Son1
    Dogru = 0
    Yanlis = 0
    Bos = 0
    s1.Range("H" & i & ":J" & i).ClearContents
        If s1.Cells(i, 2) = "a" Then
            Satir = 2
        ElseIf s1.Cells(i, 2) = "b" Then
            Satir = 3
        End If
        For x = 3 To 7
            If s1.Cells(i, x) <> Empty Then
                If s1.Cells(i, x) = s2.Cells(Satir, x - 1) Then
                    Dogru = Dogru + 1
                Else
                    Yanlis = Yanlis + 1
                End If
            Else
                Bos = Bos + 1
            End If
        Next x
s1.Cells(i, 8) = Dogru
s1.Cells(i, 9) = Yanlis
s1.Cells(i, 10) = Bos
Next i
Application.ScreenUpdating = True
MsgBox "İşlem tamam...", vbInformation, "ASKM"
End Sub

 

[bhdr]

Sub askm()
Dim s1, s2 As Worksheet
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
Dim Son1 As Long
Application.ScreenUpdating = False
Son1 = s1.Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To Son1
    Dogru = 0
    Yanlis = 0
    Bos = 0
    s1.Range("H" & i & ":J" & i).ClearContents
        If s1.Cells(i, 2) = "a" Then
            Satir = 2
        ElseIf s1.Cells(i, 2) = "b" Then
            Satir = 3
        End If
        For x = 3 To 7
            If s1.Cells(i, x) <> Empty Then
                If s1.Cells(i, x) = s2.Cells(Satir, x - 1) Then
                    Dogru = Dogru + 1
                Else
                    Yanlis = Yanlis + 1
                End If
            Else
                Bos = Bos + 1
            End If
        Next x
s1.Cells(i, 8) = Dogru
s1.Cells(i, 9) = Yanlis
s1.Cells(i, 10) = Bos
Next i
Application.ScreenUpdating = True
MsgBox "İşlem tamam...", vbInformation, "ASKM"
End Sub

Teşekkür ederim.

 

[askm]

Rica ederim Kolay gelsin.