dikdörtgenin kodu
Sub DikdörtgenKöşeleriYuvarlatılmış1_Tıkla()
rastgeleTestCol
End Sub
ana fonksiyon koduSub rastgeleTestCol()
't1 = Now
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
HdfSyf = IIf(Sayfa4.OptionButton1 = True, Sayfa4.OptionButton1.Caption, Sayfa4.OptionButton2.Caption)
Hdf = IIf(Sayfa4.OptionButton1 = True, True, False)
Set HdfSht = ThisWorkbook.Sheets(HdfSyf)
HdfSht.Cells.Clear
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
For Soru = 1 To SoruSay '
UstSnr = SozlukColl.Count
SonStr = HdfSht.Cells(HdfSht.Rows.Count, "A").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
HdfSht.Cells(SonStr, 1) = Soru
For x = 0 To 3
HdfSht.Cells(SonStr, x + 3) = Sht.Cells(SozlukColl(Secim(x)), -1 - Hdf + 2) 'Şıklar
Next x
HdfSht.Cells(SonStr, 2) = Sht.Cells(SozlukColl(Secim(Dogru)), Hdf + 2) 'Esas kelime
Next Soru
'Debug.Print Sht.Name, HdfSht.Name, SoruSay
't2 = Now
'Debug.Print t1, t2, DateDiff("s", t1, t2)
End Sub
hata kontrolleri eklenmedi mesela olmayan sayfayı seçerseniz hata verir yada combolar boş ise...