• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Rastgele Veri Çağırma Problemi

C

cooler_090

Katılım
17 Mart 2012
Mesajlar
5
Excel Vers. ve Dili
türkçe excel 2010
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.
 

Ekli dosyalar

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("D4:D53") = "=IF(C4=C5,D3+1,0)"
Sheets("Cevap").Range("D3") = "=COUNTIF(D4:D53,"">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("D3:D53") = ""
Range("X7:AJ56") = ""
End Sub
Genişletmek için tıkla ...
 
Son düzenleme:
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.
 
Elinize, emeğinize sağlık muhammet bey. İstediğimden fazlası olmuş. Nasıl teşekkür etsem az.
 
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.
 
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.
 
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.
 
Son düzenleme:
Hocam harikalar yaratıyorsunuz. Elinize sağlık. Çok işime yarayacaklar. Öğrencilerimin de öyle.
 
Rica ederim Hocam. Ben de başka neler yapabilirim diye düşünüyorum. Eğer bulursam paylaşırım.
 
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
 
Hocam bir tane öğretmen ve öğrenciler için diye bir dosya vardı. Onu bir inceleyiniz isterseniz.
 
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
 
Merhaba, çok eski bir tarih için yazmış olacağım. Son excel dosyasını göremedim, olan paylaşabilir mi
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst