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