วันพุธที่ 18 กรกฎาคม พ.ศ. 2555

การสุ่มข้อมูลแบบคัดออกนี้ สามารถนำไปใช้ในการแจกรางวัล ผู้ที่ได้รางวัลแล้วจะถูกคัดออกไม่นำมาสุ่มต่อ ปกติจะเป็นการสุ่มขึ้นมาเป็นครั้ง ๆ ไป ไม่ได้สุ่มขึ้นมาพร้อมกันแบบหลาย ๆ คน การทำเช่นนั้นต้องอาศัย VBA มาช่วยในการสุ่มครับ
โดยมีวิธีการคือ
  1. เตรียมชีทรายชื่อที่ต้องการสุ่มสมมุติชื่อชีท Names โดยเก็บข้อมูลที่ต้องการสุ่มไว้ในคอลัมน์ A
  2. เตรียมชีทที่ใช้ในการแสดงผลการสุ่มและเก็บข้อมูลของคนที่ถูกสุ่มแล้วแยกไว้ต่างหาก สมมุติชื่อชีท Random
  3. เขียน Code VBA เพื่อทำการสุ่มข้อมูลและเก็บข้อมูลที่ได้จากการสุ่มตามด้านล่าง
  4. สร้างปุ่มเพื่อคลิกสุ่มข้อมูลและเก็บข้อมูล โดยให้ชื่อปุ่ม Random และ Keep Value ตามลำดับ
  5. ทำการ Assigned Macro ที่ชื่อ RandomName ให้กับปุ่ม Random และ Assigned Macro ที่ชื่อ KeepVal ให้กับปุ่ม Keep Value ตามลำดับ
Code VBA สำหรับการสุ่มข้อมูล
Dim r As Range
Sub RandomName()
Dim i As Integer, j As Integer
With Worksheets("Names")
j = .Range("A65536").End(xlUp).Row - 1
i = Int(Rnd * (j - 1) + 1)
Set r = .Cells(i, 1)
End With
With Worksheets("Random")
.Range("D7") = r
.Shapes("Button 12").Visible = True
End With
End Sub

Sub KeepVal()
Dim rs As Range, rt As Range
With Worksheets("Random")
Set rs = .Range("D7")
If .Range("G7") = "" Then
Set rt = .Range("G7")
Else
Set rt = .Range("G65536").End(xlUp).Offset(1, 0)
End If
rt = rs
rt.Offset(0, -1) = rt.Offset(-1, -1) + 1
r.EntireRow.Delete
.Shapes("Button 12").Visible = False
End With
End Sub

ภาพตัวอย่างการสุ่มข้อมูล

RandomAndKeepVal

จากภาพด้านบนจะเห็นว่าเมื่อคลิกปุ่ม Random แล้วจะทำการสุ่มข้อมูลมาให้ที่ D7 และจะมีปุ่ม Keep Value ปรากฏขึ้นมาเพื่อเตรียมพร้อมสำหรับการเก็บข้อมูลไว้ที่ F7:G7 เป็นต้นไป เมื่อคลิกปุ่ม Keep Value ก็จะทำการเก็บข้อมูลที่สุ่มมาแล้ว จากนั้นจะทำการซ่อนปุ่มนี้ไว้ และจะปรากฏอีกทีเมื่อคลิกปุ่ม Random

สำหรับสมาชิกเวบ http://www.snasui.com/ สามารถดาวน์โหลดไฟล์ตัวอย่างได้จากที่นี่ครับ Random and keep value
Posted by netdesign On 07:42 No comments

0 ความคิดเห็น:

แสดงความคิดเห็น

Onsite computer repair Ramkhamhaeng.














รับซ่อมคอมพิวเตอร์นอกสถานที่ รามคำแหง บางกะปิ นวมินทร์ เสรีไทย


ค่าแรง+ค่ารถ+ลงwinodws+โปรแกรมดูหนังฟังเพลง+office+antivirus 400 บาท
ปล. ให้บริการ เฉพาะเขตพื้นที่ รามคำแหง บางกะปิ นวมินทร์ เสรีไทย ลาดพร้าวเฉพาะ บริเวณ จากเดอะมอลบางกะปิถึงโชคไชย4


สนใจติต่อ : Tel. 083-792-5426





ดูแผนที่ขนาดใหญ่ขึ้น


  • RSS
  • Delicious
  • Digg
  • Facebook
  • Twitter
  • Linkedin
  • Youtube

ป้ายกำกับ

คลังบทความของบล็อก

Advertisement

Unordered List