Tặng các bạn file "QUAY SỐ TRÚNG THƯỞNG" nhân dịp Tết cổ truyền.

Liên hệ QC
Hoàng Trọng Nghĩa

Hoàng Trọng Nghĩa

Chuyên gia GPE
Thành viên BQT
Moderator
Tham gia
17/8/08
Bài viết
8,612
Được thích
16,671
Giới tính
Nam
Nhân dịp Tết cổ truyền, có thể là tất niên và cũng có thể là tân niên, một số cty tổ chức rút thăm trúng thưởng, nếu như có một chương trình như thế này để vui chơi thì tạo thêm không khí tưng bừng cho ngày xuân phải không các bạn!

Không khác gì mấy với cách thức và giao diện của bài này:

http://www.giaiphapexcel.com/forum/...N-GiaiphapExcel-Com-lần-5&p=323317#post323317

Nhưng lần cải tiến này đã thay đổi bên trong rất nhiều, cụ thể là trước đó chỉ dùng 1 UserForm để thực hiện quay số nên nhiều công đoạn rối rắm, nay dùng tới 2 UserForm cho việc này, đồng thời cải tiến code và giao diện đẹp hơn, hiệu quả hơn.

attachment.php


attachment.php


Từ bài viết này:

Hoàng Trọng Nghĩa đã viết:
Bài này hay quá Thầy ơi, hôm nay em mới đọc được! Hay quá chỉ có chép về và nghiên cứu xem mình sẽ ứng dụng gì với hàm này đây!

SẼ NHANH CHÓNG CÓ MỘT ỨNG DỤNG XÀI CHO HÀM PictureFromObject NÀY!
Nhấp chuột vào đây để mở rộng...

http://www.giaiphapexcel.com/forum/...Sheet-lên-Button-của-Form&p=558617#post558617

tôi đã có cảm hứng và viết một ứng dụng dùng ngay cho hàm PictureFromObject nói trên, nó làm cho tôi khám phá nhiều hơn và tôi thật sự thích thú về điều đó.

Điểm nổi bật của chương trình lần này là người dùng không cần phải biết VBA cũng có thể đổi LOGO (hình ảnh) của công ty mình mà không phải Alt+F11 để đổi thủ công nữa! Chỉ cần bấm nút và thưởng thức!

attachment.php


Các bạn tải file về giải nén và trải nghiệm một ứng dụng từ hàm PictureFromObject của Thầy ndu96081631 nhé!
 

File đính kèm

  • QuaySo1.jpg
    QuaySo1.jpg
    181.5 KB · Đọc: 1,358
  • QuaySo2.jpg
    QuaySo2.jpg
    173.3 KB · Đọc: 1,227
  • QuaySo3.jpg
    QuaySo3.jpg
    198.2 KB · Đọc: 1,247
  • RutThamGPE_NewVersion_2.rar
    96.2 KB · Đọc: 833
Sắp xếp theo thời gian sắp xếp theo bầu chọn
Upvote 0
trung984 đã viết:
Hoàng Trọng Nhĩa chớp thời cơ nhanh lắm, cách Load hình ảnh được ứng dụng từ bài này.

http://www.giaiphapexcel.com/forum/showthread.php?74484-Load-Shape-của-Sheet-lên-Button-của-Form


File rất hay, nhưng cần bổ sung thêm code và quy định thời gian là bao nhiêu giây để cho nó dừng, để không phải bấm nút dừng lại.

Dù sao cũng cám ơn bạn đã có ứng dụng hay.
Nhấp chuột vào đây để mở rộng...
Đã nói bao nhiêu lần về vấn đề này rồi bạn, để nó tự dừng lại thì Thầy ndu96081631 đã làm ở file đầu tiên lận đó, chứ không phải giờ bạn mới thắc mắc đâu. Lý do đơn giản tôi làm vậy là để mang tính chất khách quan, mời một vị đại biểu lên bấm Enter để cho nó dừng lại, chứ để nó tự dừng thì nhiều người lại nghĩ mình lập trình sẳn số người dừng.
 
Upvote 0
Hoàng Trọng Nghĩa đã viết:
Đã nói bao nhiêu lần về vấn đề này rồi bạn, để nó tự dừng lại thì Thầy ndu96081631 đã làm ở file đầu tiên lận đó, chứ không phải giờ bạn mới thắc mắc đâu. Lý do đơn giản tôi làm vậy là để mang tính chất khách quan, mời một vị đại biểu lên bấm Enter để cho nó dừng lại, chứ để nó tự dừng thì nhiều người lại nghĩ mình lập trình sẳn số người dừng.
Nhấp chuột vào đây để mở rộng...

Đâu phải tất cả mọi bài đã viết thì mọi thành viên đều đọc hết (kể cả các Mod), họ chỉ đọc những bài có liên quan.

Bài bạn nêu tôi chưa đọc thì lấy gì mà biết bài viết đó nêu những vấn đề gì?

Ý của bạn muốn cho các vị Lãnh đạo hoặc đại biểu bấm thì OK. Tôi đã hiểu ý.

TB:
Nghe thiên hạ đồn là bạn vui vẽ, yêu đời, nhất là thích lai rai đúng không? Hôm nào làm một bửa, không sai không về. Còn khi nào gặp thì sẽ biết tớ là ai.

Đồng Nai đi dễ khó về,
Trai đến có vợ, gái về có con.

Vậy là bạn hiểu tớ ở đâu rồi nhé.
 
Lần chỉnh sửa cuối:
Upvote 0
Hoàng Trọng Nghĩa đã viết:
Lý do đơn giản tôi làm vậy là để mang tính chất khách quan, mời một vị đại biểu lên bấm Enter để cho nó dừng lại, chứ để nó tự dừng thì nhiều người lại nghĩ mình lập trình sẳn số người dừng.
Nhấp chuột vào đây để mở rộng...
Thế nếu ta bấm Enter để chương trình dừng lại thì không.. ăn gian được à? Bấm gì mặc chú, tôi cứ ra số... NDU được hôn?
Ẹc... Ẹc...
 
Upvote 0
ndu96081631 đã viết:
Thế nếu ta bấm Enter để chương trình dừng lại thì không.. ăn gian được à? Bấm gì mặc chú, tôi cứ ra số... NDU được hôn?
Ẹc... Ẹc...
Nhấp chuột vào đây để mở rộng...
Được chứ Thầy iu! Có điều mình tạo cảm giác í mà! Đã gian rồi thì cỡ nào cũng gian được à! hehehehe.
 
Upvote 0
Hoàng Trọng Nghĩa đã viết:
Bó tay, ăn gian thì dễ, chống ăn gian sao được Thầy ơi!
Nhấp chuột vào đây để mở rộng...

Ai mà biết đâu nè
Nhưng kinh nghiệm của tôi: Đôi khi cảm thấy vấn đề ấy không thể giải quyết nhưng thật ra vẫn có cách. Cứ suy nghĩ đi, nhiều khi có thể tìm được "gì đó" trong trái ổi đấy
 
Upvote 0
Tặng thêm cho các bạn phiên bản có nhạc!

attachment.php


Các bạn theo đường dẫn dưới đây, tải file Rar về, giải nén, chép folder QuaySo vào ổ đĩa nào đó rồi trải nghiệm với file có âm nhạc vui tươi.

Lưu ý, file Excel luôn luôn để cạnh với folder Media nhé các bạn, nói chung là 2 mục này phải để chung trong 1 folder.

http://www.mediafire.com/download/888razkss8qrua8/QuaySo.rar

CHÚC CÁC BẠN VUI VẺ!
 
Upvote 0
Hi, Anh Nghĩa em xem chương trình quay số trúng thưởng anh làm thấy rất tiện ích và có thể ứng dụng được nhiều lĩnh vực.
Tuy nhiên còn một trường hợp em muốn chọn các số theo ý muốn cần để quay được không ạ, anh có thể bổ sung giúp em ứng dụng này được không ạ.

Vi dụ câu hỏi em đặt trong file kèm ạ.
Anh xem có cách nào không giúp em với ạ.
Em cảm ơn anh!
 
Lần chỉnh sửa cuối:
Upvote 0
Miền Cát Trắng đã viết:
Hi, Anh Nghĩa em xem chương trình quay số trúng thưởng anh làm thấy rất tiện ích và có thể ứng dụng được nhiều lĩnh vực.
Tuy nhiên còn một trường hợp em muốn chọn các số theo ý muốn cần để quay được không ạ, anh có thể bổ sung giúp em ứng dụng này được không ạ.

Vi dụ câu hỏi em đặt trong file kèm ạ.
Anh xem có cách nào không giúp em với ạ.
Em cảm ơn anh!
Nhấp chuột vào đây để mở rộng...

Việc giải quyết không có gì khó cả. Chỉ có điều code của người khác, lại dài, nên tôi rất ngại đọc. Nhiều khi sửa một chỗ nhưng do nó có liên quan tới nhiều nơi nên phải dò để sửa hết, rất mất công.
Thôi thì tôi thử, không chuẩn thì chịu thôi.

Việc chọn 1 tập số để chỉ rút trong những số đó thì giải quyết quá đơn giản.
Giả sử bạn có 200 số đã chọn. Bạn hãy nhập vào A1:A200 trên sheet "Quay_So".
Ở chỗ cần phải nhập số (cửa sổ đầu tiên) thì nhập 200.
Cứ cho ct quay số thoải mái. Nếu nó chọn ra k, với 1 ≤ k ≤ 200 thì ta "coi như là" nó đã chọn số ở cell Ak. Thế thôi.

Để giải quyết thì bạn vào xem code của Form có tên là UsfQuaySo2. Trong đó có Private Sub cmdStart_Click()

Mã: 
Private Sub cmdStart_Click()
    With cmdStart
        ................
            Do
                Randomize
                pri_iRnd = Int((pri_Dic.Count) * Rnd()) + 1
                tbxNguon[COLOR=#ff0000][/COLOR][B][COLOR=#ff0000] [/COLOR][/B][COLOR=#ff0000][/COLOR]=[COLOR=#ff0000][/COLOR][B][COLOR=#ff0000] pri_Dic.Item(pri_iRnd)[/COLOR][/B]
                Sleep 10
                DoEvents
                If .Caption = QS.Caption Or pri_GameOver = True Then GoTo Ends
            Loop
Ends:
            If pri_GameOver = True Then Exit Sub
            With lstDanhSach
                .AddItem .ListCount + 1
                .List(.ListCount - 1, 1)[COLOR=#ff0000][/COLOR][B][COLOR=#ff0000] [/COLOR][/B][COLOR=#ff0000][/COLOR]=[COLOR=#ff0000][/COLOR][B][COLOR=#ff0000] pri_Dic.Item(pri_iRnd)[/COLOR][/B]
                .ListIndex = .ListCount - 1
            End With
            k = k + 1
            pri_DicCount = pri_DicCount - 1
            pri_Dic.Remove pri_iRnd
            Call CapNhatDict
            Call NhacNgungLai
        Else
            .Caption = QS.Caption
            .BackColor = MauXanhNhat
        End If
    End With
End Sub

2 dòng đỏ đỏ đổi thành
Mã: 
tbxNguon[B][COLOR=#0000ff] [/COLOR][/B][COLOR=#0000ff][/COLOR]=[COLOR=#0000ff][/COLOR][B][COLOR=#0000ff] Sheets("Quay_So").Cells([/COLOR][COLOR=#ff0000]pri_Dic.Item(pri_iRnd)[/COLOR][COLOR=#0000ff], 1)
[/COLOR][/B]...[B][COLOR=#0000ff]
[/COLOR][/B][COLOR=#0000ff][/COLOR].List(.ListCount - 1, 1)[COLOR=#0000ff][/COLOR][B][COLOR=#0000ff] [/COLOR][/B][COLOR=#0000ff][/COLOR]=[COLOR=#0000ff][/COLOR][B][COLOR=#0000ff] Sheets("Quay_So").Cells([/COLOR][COLOR=#ff0000]pri_Dic.Item(pri_iRnd)[/COLOR][COLOR=#0000ff], 1)[/COLOR][/B]
 
Lần chỉnh sửa cuối:
Upvote 0
Cháu cảm ơn Chú Siwtom đã dành thời gian tìm hiểu và giúp cháu ạ! Hihi,Cháu chạy thử thấy không có lỗi gì rồi.
Nhưng vẫn thiếu một trường hợp bắt lỗi nữa nếu dánh sách chỉ có 200 người mà nhập >200 thì sẽ thông báo lỗi giống như >999 đó ạ.
Chú xử lý giúp cháu với ạ.
------------------
Dear Anh Nghĩa ,Em muốn thêm một cột Tên người cạnh cột số may mắn được không ạ. giả sử sanh sách tên người sẽ từ xuất phát từ ô B1 ạ.
Chú Siwtom nếu có hứng thú thì xem giúp cháu với ạ.
Hihi, chương trình sẽ rất tiện ích một lần nữa cảm ơn Anh Nghĩa và Chú Siwtom.
 
Lần chỉnh sửa cuối:
Upvote 0
Miền Cát Trắng đã viết:
Cháu cảm ơn Chú Siwtom đã dành thời gian tìm hiểu và giúp cháu ạ! Hihi,Cháu chạy thử thấy không có lỗi gì rồi.
Nhưng vẫn thiếu một trường hợp bắt lỗi nữa nếu dánh sách chỉ có 200 người mà nhập >200 thì sẽ thông báo lỗi giống như >999 đó ạ.
Chú xử lý giúp cháu với ạ.
------------------
Dear Anh Nghĩa ,Em muốn thêm một cột Tên người cạnh cột số may mắn được không ạ. giả sử sanh sách tên người sẽ từ xuất phát từ ô B1 ạ.
Chú Siwtom nếu có hứng thú thì xem giúp cháu với ạ.
Hihi, chương trình sẽ rất tiện ích một lần nữa cảm ơn Anh Nghĩa và Chú Siwtom.
Nhấp chuột vào đây để mở rộng...

Thôi bạn không phải nhập gì cả. Code sẽ tự điền số lượng số.

1. Mở code của UsfQuaySo1 và thay Private Sub UserForm_Initialize() cũ bằng
Mã: 
Private Sub UserForm_Initialize()
[COLOR=#ff0000]Dim lastRow As Long[/COLOR]
    pri_hWnd = FindWindow("ThunderDFrame", Caption)
    pri_OldWidth = Width: pri_OldHeight = Height
    lblHuongDan3.Top = lblHuongDan2.Top
    pri_AllowResize = True
    
    [COLOR=#ff0000]lastRow = Sheets("Quay_So").[A65536].End(xlUp).Row
    If lastRow > 999 Then lastRow = 999
    txbSoPhieu = lastRow
    txbSoPhieu.Locked = True    
    cmdNhapPhieu.SetFocus[/COLOR]
End Sub

Đỏ đỏ là mới thêm

2. Nhập dữ liệu vào cột A từ A1. Dữ liệu có thể là số, mã nhân viên, họ tên, tóm lại là bất kỳ. Có thể vài mã, vài họ tên lẫn lộn, không nhất thết phải là số và không nhất thiết cùng kiểu số hay chữ.

Tôi không hiểu bạn cần cả số cả tên người làm gì.
Nếu bạn có danh sách họ tên thì nhập thẳng vào cột A. Lúc đó trong "cột số may mắn" và textbox "Số phiếu may mắn" sẽ chỉ có toàn tên. Tất nhiên lúc đó nên sửa 2 Label thành "Người may mắn".
 
Upvote 0
siwtom đã viết:
Thôi bạn không phải nhập gì cả. Code sẽ tự điền số lượng số.

1. Mở code của UsfQuaySo1 và thay Private Sub UserForm_Initialize() cũ bằng
Mã: 
Private Sub UserForm_Initialize()
[COLOR=#ff0000]Dim lastRow As Long[/COLOR]
    pri_hWnd = FindWindow("ThunderDFrame", Caption)
    pri_OldWidth = Width: pri_OldHeight = Height
    lblHuongDan3.Top = lblHuongDan2.Top
    pri_AllowResize = True
    
    [COLOR=#ff0000]lastRow = Sheets("Quay_So").[A65536].End(xlUp).Row
    If lastRow > 999 Then lastRow = 999
    txbSoPhieu = lastRow
    txbSoPhieu.Locked = True    
    cmdNhapPhieu.SetFocus[/COLOR]
End Sub

Đỏ đỏ là mới thêm

2. Nhập dữ liệu vào cột A từ A1. Dữ liệu có thể là số, mã nhân viên, họ tên, tóm lại là bất kỳ. Có thể vài mã, vài họ tên lẫn lộn, không nhất thết phải là số và không nhất thiết cùng kiểu số hay chữ.

Tôi không hiểu bạn cần cả số cả tên người làm gì.
Nếu bạn có danh sách họ tên thì nhập thẳng vào cột A. Lúc đó trong "cột số may mắn" và textbox "Số phiếu may mắn" sẽ chỉ có toàn tên. Tất nhiên lúc đó nên sửa 2 Label thành "Người may mắn".
Nhấp chuột vào đây để mở rộng...

Một lần nữa cháu xin cảm ơn chú, giờ cháu mới biết đến điều đó.
Ngoài ra cháu muốn hỏi Chú thêm nếu chuyển danh sách từ địa chỉ A1:A thành địa chỉ C2:C thì code có phải sửa lại rắc rối không ạ, sở dĩ cháu hỏi vậy vì phải tùy biến theo bảng số liệu bao gồm cả tiêu đề nữa ạ.
 
Upvote 0
Miền Cát Trắng đã viết:
Một lần nữa cháu xin cảm ơn chú, giờ cháu mới biết đến điều đó.
Nhấp chuột vào đây để mở rộng...
Tôi nói là nhập các số vào cột A chỉ vì trong bài #12 bạn viết
em muốn chọn các số theo ý muốn
Nhấp chuột vào đây để mở rộng...

Nhìn vào code trong bài #13
Mã: 
tbxNguon= Sheets("Quay_So").Cells(pri_Dic.Item(pri_iRnd), 1)
...
.List(.ListCount - 1, 1)= Sheets("Quay_So").Cells(pri_Dic.Item(pri_iRnd), 1)

Ta thấy là ListBox và TextBox nhặt dữ liệu từ các ô trong cột A. Không có chỗ nào nói dữ liệu phải là số cả.

Ngoài ra cháu muốn hỏi Chú thêm nếu chuyển danh sách từ địa chỉ A1:A thành địa chỉ C2:C thì code có phải sửa lại rắc rối không ạ, sở dĩ cháu hỏi vậy vì phải tùy biến theo bảng số liệu bao gồm cả tiêu đề nữa ạ.
Nhấp chuột vào đây để mở rộng...

Tôi thấy bạn đọc code mà không hiểu nên tôi sẽ tạo một biến để nhập ô đầu tiên của dữ liệu, vd. A1, C2 hoặc tùy ý. Lúc tùy biến thì bạn chỉ phải sửa 1 chỗ duy nhất mà thôi.

1. Trong code của module mdlPublic ở gần đầu có dòng
Mã: 
[COLOR=#0000ff]Public pub_Music As String, pub_Path As String, pub_SongList[/COLOR]

Bạn thêm một dòng ở bên dưới có nội dung
Mã: 
Public cellStart As Range

2. Trong code của Private Sub cmdStart_Click trong UsfQuaySo2 có 2 dòng đã nói ở bài #13
Mã: 
tbxNguon= ...
...
.List(.ListCount - 1, 1)= ...

Code mới của 2 dòng đó là
Mã: 
tbxNguon = cellStart.Offset(pri_Dic.Item(pri_iRnd) - 1).Value
...
.List(.ListCount - 1, 1) = cellStart.Offset(pri_Dic.Item(pri_iRnd) - 1).Value

3. Code mới của Private Sub UserForm_Initialize trong code của UsfQuaySo1
Mã: 
Private Sub UserForm_Initialize()
Dim count As Long
    pri_hWnd = FindWindow("ThunderDFrame", Caption)
    pri_OldWidth = Width: pri_OldHeight = Height
    lblHuongDan3.Top = lblHuongDan2.Top
    pri_AllowResize = True
    
    Set cellStart = [B][COLOR=#ff0000][A1][/COLOR][/B]
    count = cellStart.End(xlDown).Row - cellStart.Row + 1
    If count > 999 Then count = 999
    txbSoPhieu = count
    cmdNhapPhieu.SetFocus
End Sub

Đó là tất cả những gì bạn cần sửa. Mỗi lần thay đổi vị trí của dữ liệu thì chỉ sửa 1 chỗ duy nhất đỏ đỏ. Tức nhập ô đầu tiên của dữ liệu. Ví dụ bạn có C2:Cxyz thì nhập vào chỗ đỏ đỏ [C2]

Nhớ nhập dữ liệu không có dòng trống.
 
Upvote 0
Thầy ơi xem lại dùm em. Công ty em tới hơn 5000 nhân viên mà số phiếu chỉ cho nhập tối đa là 999 phiếu. Thầy chỉnh lại chổ này nhé. Để tiện cho người sử dụng Thầy thiết kế Form danh sách nhân viên bao gồm tên, mã nhân viên, bộ phận từ excel... sau đó sẽ import vào chương trình quay số thì sẽ tuyệt vời hơn.
 
Upvote 0
Hôm rảnh rỗi được nghỉ làm em ngồi xem lại chương trình của anh Nghĩa thấy cũng hay hay :-=.

vuongtoituonglai đã viết:
Thầy ơi xem lại dùm em. Công ty em tới hơn 5000 nhân viên mà số phiếu chỉ cho nhập tối đa là 999 phiếu. Thầy chỉnh lại chổ này nhé. Để tiện cho người sử dụng Thầy thiết kế Form danh sách nhân viên bao gồm tên, mã nhân viên, bộ phận từ excel... sau đó sẽ import vào chương trình quay số thì sẽ tuyệt vời hơn.
Nhấp chuột vào đây để mở rộng...

Code trong UsfQuaySo1 có đoạn:
Mã: 
Private Sub txbSoPhieu_Change()
    If Val(txbSoPhieu) = 0 Or txbSoPhieu = "" Or Val(txbSoPhieu) > [COLOR=#800080][B]999[/B][/COLOR] Then
        lblHuongDan2.Visible = False
        cmdNhapPhieu.Visible = False
    Else
        lblHuongDan2.Visible = True
        cmdNhapPhieu.Visible = True
    End If
    If Val(txbSoPhieu) > [COLOR=#800080][B]999 [/B][/COLOR]Then
        lblHuongDan3.Visible = True
    Else
        lblHuongDan3.Visible = False
    End If
End Sub
Bạn sửa thành 9999 là được, và cũng thêm một số 9 vào trong: lblHuongDan3
Trong lblNgauNhien của UsfQuaySo2 bạn thêm 1 số 0 nữa.
Và code trong UsfQuaySo2 là:
Mã: 
Private Sub lstDanhSach_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    On Error Resume Next
    With lstDanhSach
        If .ListCount = 0 Then Exit Sub
        If UniMsgBox(MsgXoa.Caption, vbQuestion + vbYesNo, "THÔNG BÁO") = vbYes Then
            .RemoveItem (.ListIndex)
            pri_SoLan = pri_SoLan - 1
            For i = 1 To pri_SoLan
                .List(i - 1, 0) = i
            Next i
            If .ListCount = 0 Then
                lblPhieuMM.Caption = PhieuMM.Caption & 1 & " / " & pub_SoPhieu
                lblNgauNhien.Caption = "000[COLOR=#ff0000][B]0[/B][/COLOR]"
                lblNgauNhien.ForeColor = MauXam
                lblSTT.Visible = False
                lblSoMayMan.Visible = False
                lstDanhSach.Visible = False
            Else
                lblPhieuMM.Caption = PhieuMM.Caption & pri_SoLan & " / " & pub_SoPhieu
                lblNgauNhien.Caption = .List(.ListCount - 1, 1)
            End If
        End If
    End With
    cmdStart.SetFocus
End Sub
Chỗ đo đỏ là chỗ thêm vào.
Bạn xem file kèm nhé.
Nếu bạn muốn có password VBA thì liên hệ riêng với Anh Nghĩa nhé đẹp zai nhé (^_-).

--------------------------------------
siwtom đã viết:
Việc giải quyết không có gì khó cả. Chỉ có điều code của người khác, lại dài, nên tôi rất ngại đọc. Nhiều khi sửa một chỗ nhưng do nó có liên quan tới nhiều nơi nên phải dò để sửa hết, rất mất công.
Thôi thì tôi thử, không chuẩn thì chịu thôi.

Việc chọn 1 tập số để chỉ rút trong những số đó thì giải quyết quá đơn giản.
Giả sử bạn có 200 số đã chọn. Bạn hãy nhập vào A1:A200 trên sheet "Quay_So".
Ở chỗ cần phải nhập số (cửa sổ đầu tiên) thì nhập 200.
Cứ cho ct quay số thoải mái. Nếu nó chọn ra k, với 1 ≤ k ≤ 200 thì ta "coi như là" nó đã chọn số ở cell Ak. Thế thôi.

Để giải quyết thì bạn vào xem code của Form có tên là UsfQuaySo2. Trong đó có Private Sub cmdStart_Click()

Mã: 
Private Sub cmdStart_Click()
    With cmdStart
        ................
            Do
                Randomize
                pri_iRnd = Int((pri_Dic.Count) * Rnd()) + 1
                tbxNguon=[B][COLOR=#ff0000] pri_Dic.Item(pri_iRnd)[/COLOR][/B]
                Sleep 10
                DoEvents
                If .Caption = QS.Caption Or pri_GameOver = True Then GoTo Ends
            Loop
Ends:
            If pri_GameOver = True Then Exit Sub
            With lstDanhSach
                .AddItem .ListCount + 1
                .List(.ListCount - 1, 1)=[B][COLOR=#ff0000] pri_Dic.Item(pri_iRnd)[/COLOR][/B]
                .ListIndex = .ListCount - 1
            End With
            k = k + 1
            pri_DicCount = pri_DicCount - 1
            pri_Dic.Remove pri_iRnd
            Call CapNhatDict
            Call NhacNgungLai
        Else
            .Caption = QS.Caption
            .BackColor = MauXanhNhat
        End If
    End With
End Sub

2 dòng đỏ đỏ đổi thành
Mã: 
tbxNguon=[B][COLOR=#0000ff] Sheets("Quay_So").Cells([/COLOR][COLOR=#ff0000]pri_Dic.Item(pri_iRnd)[/COLOR][COLOR=#0000ff], 1)
[/COLOR][/B]...[B][COLOR=#0000ff]
[/COLOR][/B].List(.ListCount - 1, 1)=[B][COLOR=#0000ff] Sheets("Quay_So").Cells([/COLOR][COLOR=#ff0000]pri_Dic.Item(pri_iRnd)[/COLOR][COLOR=#0000ff], 1)[/COLOR][/B]
Nhấp chuột vào đây để mở rộng...

Em chào Thầy siwtom ạ!
Em thấy cách đưa số theo cách này sẽ tiện hơn rất nhiều vì có thể tự do tùy biến theo ý thích, Tuy nhiên nếu dùng theo cách này ta có thể ăn gian được theo cách nhập nhiều lần một số nào đó vào trong list như vậy tỷ lệ trúng sẽ rất cao,đúng không Thầy.
Hì, Nhưng có một chỗ đáng chú ý là khả năng số nhập vào nhiều lần đó cũng sẽ được trúng thưởng nhiều lần.Giả sử ta đưa 10 con số 86 vào trong list thì cơ hội trúng của số 86 sẽ rất cao có và có thể nhận được tối đa 10 giải thưởng.
Thầy giúp em sửa lại để nếu những số nhập vào nhiều lần như thế này thì chỉ nhận được một lần giải thôi không ạ nghĩa là lần quay sau sẽ không được giải nữa ạ, hihi!
Ý em muốn nói cũng giống như là bốc thăm vậy lá phiếu nào được lấy ra khỏi thùng thì loại, không được bỏ vào thùng nữa ,phải dành lượt cho người sau nữa Thầy ạ.

Cảm ơn Thầy!
 
Lần chỉnh sửa cuối:
Upvote 0
KUMI đã viết:
Hôm rảnh rỗi được nghỉ làm em ngồi xem lại chương trình của anh Nghĩa thấy cũng hay hay :-=.





Em chào Thầy siwtom ạ!
Em thấy cách đưa số theo cách này sẽ tiện hơn rất nhiều vì có thể tự do tùy biến theo ý thích, Tuy nhiên nếu dùng theo cách này ta có thể ăn gian được theo cách nhập nhiều lần một số nào đó vào trong list như vậy tỷ lệ trúng sẽ rất cao,đúng không Thầy.
Hì, Nhưng có một chỗ đáng chú ý là khả năng số nhập vào nhiều lần đó cũng sẽ được trúng thưởng nhiều lần.Giả sử ta đưa 10 con số 86 vào trong list thì cơ hội trúng của số 86 sẽ rất cao có và có thể nhận được tối đa 10 giải thưởng.
Thầy giúp em sửa lại để nếu những số nhập vào nhiều lần như thế này thì chỉ nhận được một lần giải thôi không ạ nghĩa là lần quay sau sẽ không được giải nữa ạ, hihi!
Ý em muốn nói cũng giống như là bốc thăm vậy lá phiếu nào được lấy ra khỏi thùng thì loại, không được bỏ vào thùng nữa ,phải dành lượt cho người sau nữa Thầy ạ.

Cảm ơn Thầy!
Nhấp chuột vào đây để mở rộng...

Sửa code của người khác rất mệt vì phải đọc toàn bộ code để biết nó làm gì, để biết khi sửa "chỗ này" thì phải sửa cả "chỗ kia".

Gọi là chơi vui chứ có phải quay tiền bạc tỷ, thắng ô tô đâu mà chơi trò ăn gian.
Về việc loại những "mục" đã được quay thì nếu tôi không lầm thì code của Nghĩa có loại.

Sửa kiểu chắp vá thì không khó. Nếu không muốn thay đổi nhiều trong code đã có thì vd. có thể lọc duy nhất dữ liệu trong cột "bí mật" --> xóa dữ liệu cũ trong cột "bí mật" --> đập dữ liệu đã lọc trở lại cột "bí mật" --> lúc mày mới thực hiện
Mã: 
    count = cellStart.End(xlDown).Row - cellStart.Row + 1
    If count > 999 Then count = 999
    txbSoPhieu = count
    cmdNhapPhieu.SetFocus

Cũng có thể không xóa/đập trở lại làm gì. Ta tạo dic sau đó: lọc duy nhất dữ liệu trong cột "bí mật" vào dic với key = 1, 2, 3, ... còn Item = dữ liệu lọc.. Sau đó
Mã: 
    count = dic.count
    If count > 999 Then count = 999
    txbSoPhieu = count
    cmdNhapPhieu.SetFocus

Và
Mã: 
tbxNguon = dic.Item(pri_Dic.Item(pri_iRnd))
...
.List(.ListCount - 1, 1) = dic.Item(pri_Dic.Item(pri_iRnd))

DIC thì bàn nhiều, học nhiều rồi nên ai cần thì cứ tìm và tham khảo thôi.

Tôi viết chay trong notepad nên có thể nhầm lẫn.
-------------
Quà của bạn Nghĩa, code của bạn Nghĩa, tác phẩm của bạn Nghĩa. Ai có yêu cầu sửa thì liên hệ với Nghĩa. Tôi dừng ở đây.

Mà bạn Nghĩa kể cũng lạ. Quà của bạn mà có người hỏi bạn chỉ âm thầm đứng cười. Nếu không muốn sửa thì cũng nói với người hỏi một câu chứ nhỉ. Tôi vào trả lời chẳng qua là bạn Miền Cát Trắng nhờ và tôi đã trót lao vào chứ tôi không quan tâm. Nhưng bây giờ là tôi ngừng.
-----
Mà tôi tự ý sửa tác phẩm của bạn Nghĩa mà không xin phép. Chỉ sợ gặp rồi họ xin tí tiết thì toi đời tôi.
 
Lần chỉnh sửa cuối:
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

hongphuong1997
  • Question
Lấy các ký tự bất kỳ trong các ô
Trả lời
1
Đọc
16
Phuocam
Phuocam
LuuGiaPhúc
Tìm công thức mảng tính giá trị lớn nhất theo từng hàng
Trả lời
9
Đọc
148
VetMini
V
hongquan93vn
Tìm công thức có thể đánh STT của giá trị mỗi lần xuất hiện
2
Trả lời
25
Đọc
351
VetMini
V
phunguyenkt
  • Question
MN cho em xin phần mềm chuyển đổi số sang chữ với ạ, và ko có chữ chẵn, em cảm ơn
Trả lời
1
Đọc
66
le_vis
L
H
Cần giúp tìm kiếm SQL từ VBA với điều kiện Tiếng Việt
Trả lời
1
Đọc
78
AutoReply
AutoReply
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom