Rastgele Veri Çağırma Problemi

[cooler_090]

Merhaba arkadaşlar,

Ben excel bilgisi zayıf bir ingilizce öğretmeniyim. Öğrencilerime quiz sınavları hazırlamak için bir şablon oluşturmaya çalışıyorum.
Yapmak istediğim şey şu :

Bir sayfada kelimeler ve anlamlarının olduğu bir veri tabanı hazırladım. İkinci bir sayfa da ise, sınav kağıdını hazırladım. Sınav kağıdında, sadece soracağım kelime ve yazılması gereken 4 şık doldurulmayı bekliyor.(50 soruluk)

Öncelikli amacım, şıkların veri tabanını barındıran sayfayı kullanılarak, otomatik olarak rastgele doldurulmasını sağlamak. Elle yazmak çok zaman alıyor.

Daha iyisini yapabilirim diyen varsa, sonraki amacım, sorulacak kelimeyi de seçip onun cevabını da şıkların arasına rastgele yerleştirmek olacak.(Bu sanırım baya zor bir hedef.)

Yardımcı olup eğitime katkıda bulunabilecek bir üstat varsa müteşekkir olurum. İlgilenebilecekler için daha iyi anlayabilmeniz amacıyla dosyamı ekliyorum.

Şimdiden teşekkürler.

 

[Muhammet Okumuş]

Merhaba,
Sayfanın parolası nedir?

 

[cooler_090]

Buyrun, parolasız olanı.

 

[Muhammet Okumuş]

Merhaba,
Dosyayı inceleyiniz.

'Muhammet Okumuş 05.04.2013
Sub RastgeleDağıt()
Application.ScreenUpdating = False
son = Sheets(1).Cells(Rows.Count, "A").End(3).Row
Range("AB7:AB56") = "=COUNTIF(X7:AA7,MODE(X7:AA7))"
Range("AC7:AF56") = "=MATCH(LARGE($AG7:$AJ7,COLUMN(A1)),$AG7:$AJ7,0)"
Range("X57") = "=COUNTIF(X7:X56,MODE(X7:X56))+SUM(AB7:AB56)"
Sheets("Cevap").Range("D453") = "=IF(C4=C5,D3+1,0)"
Sheets("Cevap").Range("D3") = "=COUNTIF(D453,"">2"")"
5
For i = 7 To 56
10
Range("X" & i & ":AA" & i) = "=INT(RAND()*" & son - 1 & "+1)"
Range("X" & i & ":AA" & i) = Range("X" & i & ":AA" & i).Value
If Range("X57") > 0 Then GoTo 10
Range("AG" & i & ":AJ" & i) = "=RAND()"
Range("AG" & i & ":AJ" & i) = Range("AG" & i & ":AJ" & i).Value
Next
a = 4
b = 29

For i = 7 To 56 Step 2

Cells(i, 3) = Sheets(1).Range("A1").Offset(Cells(i, 24), 0)
Cells(i + 1, Cells(i, 29) * 2 + 2) = Sheets(1).Range("B1").Offset(Cells(i, 24), 0)
Cells(i + 1, Cells(i, 30) * 2 + 2) = Sheets(1).Range("B1").Offset(Cells(i, 25), 0)
Cells(i + 1, Cells(i, 31) * 2 + 2) = Sheets(1).Range("B1").Offset(Cells(i, 26), 0)
Cells(i + 1, Cells(i, 32) * 2 + 2) = Sheets(1).Range("B1").Offset(Cells(i, 27), 0)
Sheets("Cevap").Cells(a, 3) = WorksheetFunction.VLookup(Cells(i, 29).Value, Sheets("Cevap").Range("I4:J7"), 2, 0)
Sheets("Cevap").Cells(b, 3) = WorksheetFunction.VLookup(Cells(i + 1, 29).Value, Sheets("Cevap").Range("I4:J7"), 2, 0)

Sheets("Analiz").Cells(4, a) = WorksheetFunction.VLookup(Cells(i, 29).Value, Sheets("Cevap").Range("I4:J7"), 2, 0)
Sheets("Analiz").Cells(4, b) = WorksheetFunction.VLookup(Cells(i + 1, 29).Value, Sheets("Cevap").Range("I4:J7"), 2, 0)

Cells(i, 13) = Sheets(1).Range("A1").Offset(Cells(i + 1, 24), 0)
Cells(i + 1, Cells(i + 1, 29) * 2 + 12) = Sheets(1).Range("B1").Offset(Cells(i + 1, 24), 0)
Cells(i + 1, Cells(i + 1, 30) * 2 + 12) = Sheets(1).Range("B1").Offset(Cells(i + 1, 25), 0)
Cells(i + 1, Cells(i + 1, 31) * 2 + 12) = Sheets(1).Range("B1").Offset(Cells(i + 1, 26), 0)
Cells(i + 1, Cells(i + 1, 32) * 2 + 12) = Sheets(1).Range("B1").Offset(Cells(i + 1, 27), 0)

a = a + 1
b = b + 1
Next
If Sheets("Cevap").Range("D3") > 0 Then GoTo 5
Sheets("Cevap").Range("D353") = ""
Range("X7:AJ56") = ""
End Sub

 

[Muhammet Okumuş]

Dosyayı incelerken veri tabanında road ve way kelimelerin Türkçe karşılıkları ikisininde aynı olduğunu gördüm. Bu cevaplarda iki aynı şıkkın olmasına neden olabilir.Örneğin road kelimesi soru aolarak sorulduğunda yol kelimesi iki şıkta olabilir. Neticede rastgele olduğu için böyle bir durum ile karşılaşabilirsiniz. Bu yüzden İngilizce-Türkçe kelimelerinin mükerrer olmamasına dikkat ediniz. Ayrıca cevap anahtarında üst üste 3 ten fazla şık gelmemesi koşulu ekledim.

 

[cooler_090]

Elinize, emeğinize sağlık muhammet bey. İstediğimden fazlası olmuş. Nasıl teşekkür etsem az.

 

[cooler_090]

Hatta çok mükemmel olmuş. Valla tekrar sağolun. Emek verdiniz. Sizin için de sakıncası yoksa ingilizce öğretmenlerinin bol olduğu bir sitede sizin isminizi de ekleyerek paylaşıma açacağım. Hem öğrenciler hem öğretmenler faydalansın.

 

[Muhammet Okumuş]

Rica ederim Hocam. Benim için bir sakıncası yok. Neticede bende eğitim camiasının içindeyim. Öğretmenler ve öğrencilerin için faydalı olacaksa ne mutlu bana.

 

[Muhammet Okumuş]

Bir tane Quiz sayfası ekledim. Türkçe-İngilizce, İngilizce-Türkçe olarak ayrı iki seçenek var. Cevap üzerine tıklayarak cevap işaretlenmiş oluyor. Aynı cevap üzerine bir kez daha tıklarsanız, boş bırakmış oluyorsunuz.

 

[cooler_090]

Hocam harikalar yaratıyorsunuz. Elinize sağlık. Çok işime yarayacaklar. Öğrencilerimin de öyle.

 

[Muhammet Okumuş]

Rica ederim Hocam. Ben de başka neler yapabilirim diye düşünüyorum. Eğer bulursam paylaşırım.

 

[38can38]

hocam bende indirdim gerçekten süper olmuş ellerinize sağlık 5 sınıfa giden oğlum için çok iyi olacak bugün günboyu bunun ile çalıştık 5 sınıf ingilizce kelimelerini yazdı yazarken çoğunu öğrendi birde hocam bunu normal test için yapabilirmisiniz türkçe matamatik fen sosyal öğrenci kendine test hazırlarken çalışır öğrenir siz eğtimcilerimiz olmasa bizler ne yaparız çok teşekkürler

 

[Muhammet Okumuş]

Hocam bir tane öğretmen ve öğrenciler için diye bir dosya vardı. Onu bir inceleyiniz isterseniz.

 

[38can38]

tamam hocam onlarıda bugün indirmiştimde senin tasarın daha hoşuma gitti emeğine sağlık onlarada tekrar bakayım teşekkürler

 

[tr1066tc]

Merhaba, çok eski bir tarih için yazmış olacağım. Son excel dosyasını göremedim, olan paylaşabilir mi