Skip to main content

AccessTr.neT


İngilizce Eğitim Combobox İle Sayfa Seçiminde Hata

Oğuz Türkyılmaz
Oğuz Türkyılmaz
8
1220

İngilizce Eğitim Combobox İle Sayfa Seçiminde Hata

Çözüldü #1
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.

[Resim: do.php?img=11080]

[Resim: do.php?img=11081]

Kod:
Public TestDz() As Variant

Sub rastgeleTestCol()
Dim SonStr As Long
Dim Secim(0 To 3)

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")

SoruSay = Int(Sayfa4.ComboBox2)

Set SozlukColl = New Collection
'hy____________________________Sözcükler için satır seçme
For x = 2 To SonStr
    SozlukColl.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
   
    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
    Randomize
    Dogru = Int((3 - 0 + 1) * Rnd + 0) 'Esas kelimeyi seçme
    TestDz(Soru, 1) = Soru 'Soru No
    For x = 0 To 3
    TestDz(Soru, x + 4) = sht.Cells(SozlukColl(Secim(x)), -1 - Hdf + 2)
        HdfSht.Range("E" & SonStr).Formula = "=If(D" & SonStr & "="""",""Boş"",If(C" & SonStr & "=D" & SonStr & ",""Doğru"",""Yanlış""))"
    Next x
    TestDz(Soru, 2) = sht.Cells(SozlukColl(Secim(Dogru)), Hdf + 2)
    TestDz(Soru, 3) = sht.Cells(SozlukColl(Secim(Dogru)), -1 - Hdf + 2)

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

End Sub

.rar ENG_TUR DİL EĞİTİM .rar (Dosya Boyutu: 1,49 MB | İndirme Sayısı: 4)
Access Çekirgesi 
[Resim: img-cray.gif]


Son Düzenleme: 31/05/2021, 21:53, Düzenleyen: Oğuz Türkyılmaz.
Cevapla
#2
Henüz inceleme firsatim olmadi ama sunu sorayım  kaç soru seçtiniz ve o sayfada kaç satır veri var
Cevapla
#3
(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.
Access Çekirgesi 
[Resim: img-cray.gif]


Cevapla
#4
  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
Cevapla
#5
Sanıyorum kod hatalı çalışıyor.
Dosyadaki hata collectiondan silinince ve o silinen iteme denk gelince ve bulunamıyor ondan dolayı hata veriyor abey.
Cevapla
#6
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
.rar ENG_TUR DİL EĞİTİM_hy10 .rar (Dosya Boyutu: 1,5 MB | İndirme Sayısı: 13)
Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da
Task