AccessTr.neT

Merhaba
Uygulamada combobox ile soru tipi seçiminde database sayfasında kod çalışıyor ve rasgele sorular oluşturuluyor fakat yeni düzenlenen verbs sayfasını combobox'dan seçip bu sayfadaki A ve B sütunlarındaki bilgilerden rasgele sorular oluşturmaya çalıştığımda hata alıyorum. Yardımlarınız için teşekkür ederim.

Henüz inceleme firsatim olmadi ama sunu sorayım  kaç soru seçtiniz ve o sayfada kaç satır veri var

(31/05/2021, 21:58)berduş yazdı: [ -> ]Henüz inceleme firsatim olmadi ama sunu sorayım  kaç soru seçtiniz ve o sayfada kaç satır veri var

@berduş hocam 10 soru seçtim 80 satır veri var.

  For x = 0 To 3 'Rasgele 4 kelime için satýr seçme

        UstSnr = SozlukColl.Count

        Randomize

        KelimSira = Int((UstSnr - AltSnr + 1) * Rnd + AltSnr)

        Secim(x) = KelimSira

        SozlukColl.Remove (KelimSira) 'seçilen satýrý silme

    Next x

Yukardaki kodu alttaki gibi değiştirip deneyin.

    For x = 0 To 3 'Rasgele 4 kelime için satır seçme

        UstSnr = SozlukColl.Count

var:

        Randomize

        KelimSira = Int((UstSnr - AltSnr + 1) * Rnd + AltSnr)

        Secim(x) = KelimSira

        For kontrol = 0 To x - 1

            If Secim(x) = Secim(kontrol) Then GoTo var

        Next

    Next x

Sanıyorum kod hatalı çalışıyor.
Dosyadaki hata collectiondan silinince ve o silinen iteme denk gelince ve bulunamıyor ondan dolayı hata veriyor abey.

rasgele fonksiyonunu aşağıdaki gibi düzenleyip deneyebilirsiniz

Sub rastgeleTestCol()

Dim SonStr As Long

Dim Secim(5 To 8)



Set sht = ThisWorkbook.Sheets(Sayfa4.ComboBox1.Value)

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

    If SonStr < 2 Then Exit Sub



Hdf = IIf(Sayfa4.BtnEngTr = True, True, False)

Set HdfSht = ThisWorkbook.Sheets("RESULTS")

    MaxSoruSay = HdfSht.Cells(HdfSht.Rows.Count, "E").End(xlUp).Row



SoruSay = Int(Sayfa4.ComboBox2)

If SoruSay >= SonStr - 1 Then

    SoruSay = SonStr - 1

    MsgBox "Girdiğiniz soru sayısı veri miktarından daha fazla. Soru sayınız veri miktarına düşürülmüştür!"

End If



Set SozlukColl = New Collection

Set SecenekColl = New Collection

'hy____________________________Sözcükler için satır seçme

For x = 2 To SonStr

    SozlukColl.Add x 'Collectiona değer atama

    SecenekColl.Add x 'Collectiona değer atama

Next x



AltSnr = 1

ReDim TestDz(1 To SoruSay, 1 To 8)

For Soru = 1 To SoruSay '

    UstSnr = SozlukColl.Count

    SonStr = HdfSht.Cells(HdfSht.Rows.Count, "E").End(xlUp).Row + 1



'hy_________________________________________Soru İçin Kelime Seçme

        UstSnr = SozlukColl.Count

        Randomize

        KelimSira = Int((UstSnr - AltSnr + 1) * Rnd + AltSnr) 'Ana kelimeyi Seçme

        

        TestDz(Soru, 1) = Soru

        TestDz(Soru, 2) = sht.Cells(SozlukColl(KelimSira), Hdf + 2) 'Ana Kelimeyi diziye atama

        TestDz(Soru, 3) = sht.Cells(SozlukColl(KelimSira), -1 - Hdf + 2) 'Cevabı diziye atama

        TestDz(Soru, 4) = "Boş"

        SozlukColl.Remove (KelimSira) 'seçilen kelimeyi silme

    

'hy_________________________________________Şık İçin Kelime Seçme

    For x = 5 To 8

        Randomize

    '  KelimSira = Int((UstSnr - AltSnr + 1) * Rnd + AltSnr)

        Secenek = Int((SecenekColl.Count - 1 + 1) * Rnd + 1) 'Esas kelimeyi seçme

        Secim(x) = Secenek

        TestDz(Soru, x) = sht.Cells(SecenekColl(Secenek), -1 - Hdf + 2)

        SecenekColl.Remove Secim(x)

            HdfSht.Range("E" & SonStr).Formula = "=If(D" & SonStr & "="""",""Boş"",If(C" & SonStr & "=D" & SonStr & ",""Doğru"",""Yanlış""))"

    Next x

    

'hy_________________________________________Şık İçin Seçilen kelimeliri geri ekleme

    For x = 5 To 8

        SecenekColl.Add Secim(x)

    Next x

    

        Randomize

    '  KelimSira = Int((UstSnr - AltSnr + 1) * Rnd + AltSnr)

        DogruCvp = Int((8 - 5 + 1) * Rnd + 5)

        TestDz(Soru, DogruCvp) = TestDz(Soru, 3)



Next Soru

ThisWorkbook.Sheets("Menu").Range("R8").Formula = "=" & SoruSay & "-R10"



End Sub