(24/05/2021, 15:14)Oğuz Türkyılmaz yazdı: benim 24 mesaja eklediğim uygulamayı indirip onun üzerinde denermisiniz. 

Denedim.
Alttaki gibi Sayfa4 ekleyin comboxun önüne sadece.İlk yada ikinci ile lakası yok hatanın abey.

MsgBox Sayfa4.ComboBox2.Value & " Adet Test Sorunuz Hazýrlandý. Baþarýlar dileriz.", vbExclamation, "Kelime Öðrenme Programý"

Dosyayı inceleyin.

Tesi Hazırla butonuna basmaya gerek yok sadece TESTE BAŞLA butonuna tıklayınca işlemleri yapar.
ve result sayfasında yanlış ,doğru ve boş sayılarınıda ekletip eğersay ile sonuçları yazdırdım.


https://resim.accesstr.net/do.php?img=11067

@feraz hocam seyahatteyim ilgilenemiyorum programla ama deneme yaptığım kadarıyla verilen cevapları kaydetmemiş gözüküyor halen. Doğru yanlış sayısı kayda girmiş fakat verilen cevap sütununda cevaplar kaydedilmemiş. Benim yazdığım kodda da cevapların bir kısmı doğru bir kısmı yanlış kaydediliyordu.

İyi seyahatler abey.
Resimdeki gibi formül eklememişsiniz.


https://resim.accesstr.net/do.php?img=11069

Alttaki koda yukardakini eklerseniz formüle gerek kalmaz gerçi formüllede zor olur.
Ayrıca .Range("L" & son).Value =  mod_veribul.veriAl yazılsa C6 hücresine veri almayada gerek yok.Daha doğrusu result sayfasının bc2,c4 ve c6 yeda gerek yok onlarda kodla yapılabilirdi.Videodaki kadın zaten gereksiz şeylerle uğraşmış

Sub sonsatirResult(son As Long, syf As String)

    With ThisWorkbook.Sheets(syf)

        .Range("A" & son).Value = .Range("B2").Value

        .Range("B" & son).Value = .Range("C2").Value

        .Range("G" & son).Value = .Range("C4").Value

        .Range("C6").Value = mod_veribul.veriAl

        .Range("L" & son).Value = .Range("C6").Value

       

        Dim ara As Range

        Set ara = Sayfa1.Range("A:A").Find(Sayfa4.Range("A10").Value, , , 1)

        

        If Not ara Is Nothing Then

            If ara.Offset(, 1).Value = mod_veribul.veriAl Then

                .Range("Q" & son).Value = 1

            Else

                If mod_veribul.veriAl = "" Then

                    .Range("Q" & son).Value = "Bos"

                Else

                    .Range("Q" & son).Value = 0

                End If

            End If

        End If

    End With

    mod_veribul.veriAl = ""

    Set ara = Nothing

End Sub

---

(25/05/2021, 22:08)feraz yazdı: mod_veribul.veriAl

yerine 
olarakta kısaca yazılır normalde.

menü sayfası değiştiğinde

Private Sub Worksheet_Change(ByVal Target As Range)

    If Not Intersect(Target, Range("R10")) Is Nothing And IsNumeric(Target.Value) = True Then

    Set SoruSht = ThisWorkbook.Sheets("QUE_ANS")

    Set TestSht = ThisWorkbook.Sheets("MENU")

    git = TekVeriAl(Target.Value) 'B2 değişince tetiklenir

    If git = 0 Then Exit Sub

    With SoruSht

            TestSht.Range("A10") = .Cells(git, 2)

            TestSht.Range("A12") = .Range("C" & git)

            TestSht.Range("A14") = .Range("D" & git)

            TestSht.Range("A16") = .Range("E" & git)

            TestSht.Range("A18") = .Range("F" & git)

    

    End With

    End If

End Sub

Function TekVeriAl(ByVal SoruSay As Long) As Long



Set SoruSht = ThisWorkbook.Sheets("QUE_ANS")

Set TestSht = ThisWorkbook.Sheets("MENU")

Set RngAra = SoruSht.Range("A:A")

Set RngAra = RngAra.Find(What:=CStr(SoruSay), LookAt:=xlWhole, LookIn:=xlValues)

    If RngAra Is Nothing Then

    SonStr = SoruSht.Cells(SoruSht.Rows.Count, "A").End(xlUp) '.Row

        TestSht.Range("R10") = IIf(SoruSay > SonStr, SonStr, 1)

        MsgBox "yanlış sayı girdiniz lütfen 1 - " & SonStr & " arası bir sayı giriniz."

        TekVeriAl = 0

        Exit Function 'veri yoksa işlemi iptal etme

    End If

    TekVeriAl = RngAra.Row

End Function

Teste Başlama

Sub TestBasla()

rastgeleTestCol

    ThisWorkbook.Sheets("MENU").Shapes("BtnSonraki").TextFrame.Characters.Text = "SONRAKİ SORU"

    ThisWorkbook.Sheets("MENU").OptionButtons("BtnSecenek5").Value = True

Range("R10") = 1

End Sub

Sonraki Soru

Sub SonrakiSoru()

Set TestSht = ThisWorkbook.Sheets("MENU")

Set SoruSht = ThisWorkbook.Sheets("QUE_ANS")

SonStrSoru = SoruSht.Cells(SoruSht.Rows.Count, "A").End(xlUp).Value

BasHcr = TekVeriAl(1)

BitHcr = TekVeriAl(SonStrSoru)



For x = 1 To 4

    If TestSht.OptionButtons("BtnSecenek" & CStr(x)).Value = 1 Then

        git = TekVeriAl(Range("R10"))

        Secim = Replace(TestSht.OptionButtons("BtnSecenek" & x).Name, "BtnSecenek", "")

        SoruSht.Range("H" & git).Value = TestSht.Range("A" & Secim * 2 + 10).Value 'Choose(Secim, "A", "B", "C", "D")

    End If

Next

If TestSht.Shapes("BtnSonraki").TextFrame.Characters.Text = "Testi Bitir" Then

    TestBitir

    TestSht.Shapes("BtnSonraki").TextFrame.Characters.Text = "SONRAKİ SORU"

    Exit Sub

End If





TestSht.OptionButtons("BtnSecenek5").Value = True

Range("R10") = Range("R10") + 1



If SonStrSoru = Range("R10") Then TestSht.Shapes("BtnSonraki").TextFrame.Characters.Text = "Testi Bitir"





End Sub

Testi bitir

Sub TestBitir()

Set SoruSht = ThisWorkbook.Sheets("QUE_ANS")

Set HdfSht = ThisWorkbook.Sheets("RESULTS")

    SonStrSoru = SoruSht.Cells(SoruSht.Rows.Count, "A").End(xlUp).Value

    SonStrHdf = HdfSht.Cells(HdfSht.Rows.Count, "A").End(xlUp).Row



HdfSht.Range("A2:F" & SonStrHdf).ClearContents

BasHcr = TekVeriAl(1)

BitHcr = TekVeriAl(SonStrSoru)

Set KpyRng = SoruSht.Range("A" & BasHcr & ":B" & BitHcr & ",G" & BasHcr & ":I" & BitHcr)

    KpyRng.Copy

    ThisWorkbook.Sheets("RESULTS").Range("A2").PasteSpecial Paste:=xlPasteValues

    Application.CutCopyMode = False

    HdfSht.Activate

End Sub