• DİKKAT

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

soruları rastgele sıralamak

Katılım
11 Temmuz 2007
Mesajlar
132
Excel Vers. ve Dili
2007
Merhaba arkadaşlar,
Öğrencilere 25 tane çoktan seçmeli soru yazdım. birinci sütünda soru numarası ikinci sütünda sorularım var..şimdi bu soruları A grubuna soracağım.. Fakat istiyorumki B grubuna aynı soruları ,fakat değişik satırlarda olsun..

şimdi A sütünündaki 1-25 soru numaralarını random olarak değiştirmek istiyorum..Tabii bağlı olarak soruların da sırası değişsin istiyorum böylece B grubundaki öğrenciler için aynı sorular farklı satırlarda olacak..
bunu nasıl başarırız...
Teşekkürler.
 
Örnek dosya ekleyebilirseniz yardımcı olmaya çalışayım.
 
Merhab arkadaşım istediğin basit bir dosyayı ekliyorum..

teşekkürler
 

Ekli dosyalar

Merhab arkadaşım istediğin basit bir dosyayı ekliyorum..

teşekkürler
Soruda çoktan seçmeli demişsiniz. Bu şekliyle karıştırmamı mı istiyorsunuz? Yoksa altında şıklar da olacak mı? Şıklar olacaksa ona göre bir dosya ekleyin. Onun üzerinden çalışalım.
 
altında şıklar da olsun.. arkadaşım... aynı satırda,yada altaki 4-satırı da içersin her soru..

Hücreleri mi birleştirmeliyiz ?
 
Ekli dosyayı inceleyiniz. Sorular birbirine denk gelmeyecek şekilde karışır.
Kod:
Sub dene()
Sat = [a65536].End(3).Row
Range("d2:e" & Sat).Clear
Sira = 2
Do While Sira < Sat
Tekrar:
sayi = Int((Cells(Sat - 4, "a") * Rnd) + 1)
If WorksheetFunction.CountIf(Range("d2:d" & Sat), sayi) > 0 Then GoTo Tekrar
If sayi = Cells(Sira, "a") Then Range("d2:e" & Sat).Clear: Sira = 2: GoTo Tekrar
Set Bul = Range("a2:a" & Sat).Find(sayi, Lookat:=xlWhole)
If Not Bul Is Nothing Then
Range(Cells(Bul.Row, "a"), Cells(Bul.Row, "b")).Copy Cells(Sira, "d")
Range(Cells(Bul.Row + 1, "a"), Cells(Bul.Row + 1, "b")).Copy Cells(Sira + 3, "d") 'A şıkkı
Range(Cells(Bul.Row + 2, "a"), Cells(Bul.Row + 2, "b")).Copy Cells(Sira + 4, "d") 'B şıkkı
Range(Cells(Bul.Row + 3, "a"), Cells(Bul.Row + 3, "b")).Copy Cells(Sira + 1, "d") 'C şıkkı
Range(Cells(Bul.Row + 4, "a"), Cells(Bul.Row + 4, "b")).Copy Cells(Sira + 2, "d") 'D şıkkı
End If
Sira = Sira + 5
Loop
Columns(1).Copy Columns(4)
Application.CutCopyMode = False
MsgBox "İşlem tamam.", vbInformation, "leumruk"
End Sub
 

Ekli dosyalar

Son düzenleme:
merhaba Lumruk dostum,

gönderdiğin dosyayı aldım.. butona bastığımda Makro uyarısı veriyor... Araçlar/güvenlik/yüksek...ayarlarını yaptım fakat kapatıp yeniden açınca MAKROYU ETKİNLEŞTİRME BUTONUNU BULAMADIM.. NASIL NEREDE BU ETKİNLEŞTİRME BUTONU YARDIM EDİNİZ LÜTFEN
 
tAMAM BULDUM... GÜVENLİK DÜZEYİNİ orta YAPINCA ÇALIŞTI..
TEŞEKKÜRLER..
 
Cevap için teşekkürler..
güzel olmuş..Butona basınca hedef bölümdeki soruların yeri değişmekte.. Tam istediğim gibi...bir şey daha soracağım...Peki biraz daha ileri gidip kodu modife edip seçeneklerin yerini de değiştirebilir miyiz..? zira öğrenciler yan yana oturmakta ve göz ucu ile işaretlenen cevabı görebilir.
yani A-B-C-D- sabit kalsın fakat cevaplar değişsin... A-seçeneğine bağlı cevap diyelim ki 12 ise bu on ik random olarak diğer seçeneklere dağılsın..

Teşekkürler.
 
Kodu ve dosyayı güncelledim.
 
Eline sağlık...

visual basic ile 5-6 ay uğraşmiş... birşeler yapmıştım ..fakat yıllardır uğramadım...

şimdi Flash action script ile bazen oynuyorum.. basit-oyun vs.. güzel bir hobi..
yaptığınız program-- işimi kısmen görür.

teşekkürler
 
Geri
Üst