[UserForm] Rút thăm trúng thưởng (cơ bản) (1 người xem)

Vy Bui · 13/7/19

Chào cả nhà,

Mong cả nhà giúp đỡ hướng dẫn mình thiết kế UserForm trong VBA Excel để tạo chương trình Rút thăm trúng thưởng với một số tiêu chí như:
- Chương trình rút thăm random dựa trên danh sách có sẵn (ví dụ: Mã NV, Họ và Tên), trong đó: TextBox1 bên trái thể hiện mã nhân viên, TextBox2 bên phải thể hiện tên nhân viên tương ứng với mã code của nhân viên trong TextBox1.
- Mỗi 1 nhân viên chỉ được chọn 1 lần.
- Thiết lập ban đầu cho UserForm: Khi vừa mở chương trình thì UserForm sẽ hiện full màn hình.

Mình có tham khảo bài viết của của anh Hoàng Trọng Nghĩa (https://www.giaiphapexcel.com/diend...sỐ-trÚng-thƯỞng-nhân-dịp-tết-cổ-truyền.89550/) nhưng do lượng kiến thức còn hạn chế nên chưa thể tự thiết kế chương trình riêng cho phù hợp với nhu cầu dựa trên code của anh Nghĩa được.

Cám ơn cả nhà rất nhiều.

ducdoom · 13/7/19

Xin chào!
gửi bạn code để bạn thử xem nhé!

Mã:

Private Sub UserForm_Initialize()
    'Su dung doi tuong "Me" de thay the cho ten UserForm
    Me.Top = Application.Top
    Me.Left = Application.Left
    Me.Height = Application.Height
    Me.Width = Application.Width
End Sub

Mã:

Private Sub Click_Here_Click()
    Dim wb As Workbook
    Set wb = Application.ThisWorkbook
    Dim ws As Worksheet
    Set ws = wb.Worksheets("List")
    
    Dim LR As Long
    LR = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
    Dim listRange As Range
    Set listRange = ws.Range("B2", "C" & LR)
    
    Dim indexRow As Long
    Dim Code As Variant
    
    Dim newRow As Long
    newRow = ws.Range("D" & ws.Rows.Count).End(xlUp).Row + 1
    If newRow > LR Then
        MsgBox "Ban da random het tat ca moi nguoi"
        Exit Sub
    End If
    
    Do
        indexRow = Int((LR - 2 + 1) * Rnd + 2)
        Code = ws.Range("B" & indexRow).Value2
        
        If ws.Range("D:D").Find(Code) Is Nothing Then
            textboxCode = Code
            textboxName = Application.WorksheetFunction.VLookup(Code, listRange, 2, 0)
            ws.Range("D" & newRow).Value2 = Code
            Exit Do
        End If
    Loop While newRow <= LR
                        
    '// ban hay tao them 1 Button Reset de xoa het tat ca
    '// nhung ket qua da random nhe!
    '// code: range("D:D").ClearContents
End Sub

Phuocam · 13/7/19

Hoặc thử code này:

Mã:

Option Explicit
Private DanhSach()
Private Tong_NV As Long
Private L As Long
Private Sub Click_Here_Click()
    If L > Tong_NV Then
        If MsgBox("Da het danh sach, Ban muôn chay lai", vbYesNo) = vbYes Then
            Call NgauNhien
        Else
            Unload Me
        End If
    End If
    Me.textboxCode = DanhSach(L, 1)
    Me.textboxName = DanhSach(L, 2)
    L = L + 1
End Sub
Private Sub UserForm_Initialize()
    'Su dung doi tuong "Me" de thay the cho ten UserForm
    Me.Top = Application.Top
    Me.Left = Application.Left
    Me.Height = Application.Height
    Me.Width = Application.Width
    Call NgauNhien
End Sub
Private Sub NgauNhien()
Dim LR As Long
Dim sCode As String
Dim sName As String
Dim i As Long
Dim k As Long
With Sheets("List")
    LR = .Range("A" & .Rows.Count).End(xlUp).Row
    DanhSach = .Range("B2:C" & LR).Value
    Tong_NV = UBound(DanhSach, 1)
End With
Randomize
    For i = 1 To Tong_NV
        k = Int(Rnd() * Tong_NV) + 1
        sCode = DanhSach(k, 1)
        sName = DanhSach(k, 2)
        DanhSach(k, 1) = DanhSach(i, 1)
        DanhSach(k, 2) = DanhSach(i, 2)
        DanhSach(i, 1) = sCode
        DanhSach(i, 2) = sName
    Next
    L = 1
End Sub

Vy Bui · 14/7/19

ducdoom đã viết:

Xin chào!
gửi bạn code để bạn thử xem nhé!

Mã:

Private Sub UserForm_Initialize()
    'Su dung doi tuong "Me" de thay the cho ten UserForm
    Me.Top = Application.Top
    Me.Left = Application.Left
    Me.Height = Application.Height
    Me.Width = Application.Width
End Sub

Mã:

Private Sub Click_Here_Click()
    Dim wb As Workbook
    Set wb = Application.ThisWorkbook
    Dim ws As Worksheet
    Set ws = wb.Worksheets("List")
  
    Dim LR As Long
    LR = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
    Dim listRange As Range
    Set listRange = ws.Range("B2", "C" & LR)
  
    Dim indexRow As Long
    Dim Code As Variant
  
    Dim newRow As Long
    newRow = ws.Range("D" & ws.Rows.Count).End(xlUp).Row + 1
    If newRow > LR Then
        MsgBox "Ban da random het tat ca moi nguoi"
        Exit Sub
    End If
  
    Do
        indexRow = Int((LR - 2 + 1) * Rnd + 2)
        Code = ws.Range("B" & indexRow).Value2
      
        If ws.Range("D:D").Find(Code) Is Nothing Then
            textboxCode = Code
            textboxName = Application.WorksheetFunction.VLookup(Code, listRange, 2, 0)
            ws.Range("D" & newRow).Value2 = Code
            Exit Do
        End If
    Loop While newRow <= LR
                      
    '// ban hay tao them 1 Button Reset de xoa het tat ca
    '// nhung ket qua da random nhe!
    '// code: range("D:D").ClearContents
End Sub

ducdoom đã viết:

Xin chào!
gửi bạn code để bạn thử xem nhé!

Mã:

Private Sub UserForm_Initialize()
    'Su dung doi tuong "Me" de thay the cho ten UserForm
    Me.Top = Application.Top
    Me.Left = Application.Left
    Me.Height = Application.Height
    Me.Width = Application.Width
End Sub

Mã:

Private Sub Click_Here_Click()
    Dim wb As Workbook
    Set wb = Application.ThisWorkbook
    Dim ws As Worksheet
    Set ws = wb.Worksheets("List")
   
    Dim LR As Long
    LR = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
    Dim listRange As Range
    Set listRange = ws.Range("B2", "C" & LR)
   
    Dim indexRow As Long
    Dim Code As Variant
   
    Dim newRow As Long
    newRow = ws.Range("D" & ws.Rows.Count).End(xlUp).Row + 1
    If newRow > LR Then
        MsgBox "Ban da random het tat ca moi nguoi"
        Exit Sub
    End If
   
    Do
        indexRow = Int((LR - 2 + 1) * Rnd + 2)
        Code = ws.Range("B" & indexRow).Value2
       
        If ws.Range("D:D").Find(Code) Is Nothing Then
            textboxCode = Code
            textboxName = Application.WorksheetFunction.VLookup(Code, listRange, 2, 0)
            ws.Range("D" & newRow).Value2 = Code
            Exit Do
        End If
    Loop While newRow <= LR
                       
    '// ban hay tao them 1 Button Reset de xoa het tat ca
    '// nhung ket qua da random nhe!
    '// code: range("D:D").ClearContents
End Sub

Cám ơn bạn đã dành thời gian hướng dẫn mình ah W(*.*)W

Bài đã được tự động gộp: 14/7/19

phuocam đã viết:

Hoặc thử code này:

Mã:

Option Explicit
Private DanhSach()
Private Tong_NV As Long
Private L As Long
Private Sub Click_Here_Click()
    If L > Tong_NV Then
        If MsgBox("Da het danh sach, Ban muôn chay lai", vbYesNo) = vbYes Then
            Call NgauNhien
        Else
            Unload Me
        End If
    End If
    Me.textboxCode = DanhSach(L, 1)
    Me.textboxName = DanhSach(L, 2)
    L = L + 1
End Sub
Private Sub UserForm_Initialize()
    'Su dung doi tuong "Me" de thay the cho ten UserForm
    Me.Top = Application.Top
    Me.Left = Application.Left
    Me.Height = Application.Height
    Me.Width = Application.Width
    Call NgauNhien
End Sub
Private Sub NgauNhien()
Dim LR As Long
Dim sCode As String
Dim sName As String
Dim i As Long
Dim k As Long
With Sheets("List")
    LR = .Range("A" & .Rows.Count).End(xlUp).Row
    DanhSach = .Range("B2:C" & LR).Value
    Tong_NV = UBound(DanhSach, 1)
End With
Randomize
    For i = 1 To Tong_NV
        k = Int(Rnd() * Tong_NV) + 1
        sCode = DanhSach(k, 1)
        sName = DanhSach(k, 2)
        DanhSach(k, 1) = DanhSach(i, 1)
        DanhSach(k, 2) = DanhSach(i, 2)
        DanhSach(i, 1) = sCode
        DanhSach(i, 2) = sName
    Next
    L = 1
End Sub

Mình cũng cám ơn bạn nhiều nhen, GPE thật nhiệt tình chia sẻ kiến thức và kinh nghiệm W(*.*)W

Vy Bui · 14/7/19

ducdoom đã viết:

Xin chào!
gửi bạn code để bạn thử xem nhé!

Mã:

Private Sub UserForm_Initialize()
    'Su dung doi tuong "Me" de thay the cho ten UserForm
    Me.Top = Application.Top
    Me.Left = Application.Left
    Me.Height = Application.Height
    Me.Width = Application.Width
End Sub

Mã:

Private Sub Click_Here_Click()
    Dim wb As Workbook
    Set wb = Application.ThisWorkbook
    Dim ws As Worksheet
    Set ws = wb.Worksheets("List")
   
    Dim LR As Long
    LR = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
    Dim listRange As Range
    Set listRange = ws.Range("B2", "C" & LR)
   
    Dim indexRow As Long
    Dim Code As Variant
   
    Dim newRow As Long
    newRow = ws.Range("D" & ws.Rows.Count).End(xlUp).Row + 1
    If newRow > LR Then
        MsgBox "Ban da random het tat ca moi nguoi"
        Exit Sub
    End If
   
    Do
        indexRow = Int((LR - 2 + 1) * Rnd + 2)
        Code = ws.Range("B" & indexRow).Value2
       
        If ws.Range("D:D").Find(Code) Is Nothing Then
            textboxCode = Code
            textboxName = Application.WorksheetFunction.VLookup(Code, listRange, 2, 0)
            ws.Range("D" & newRow).Value2 = Code
            Exit Do
        End If
    Loop While newRow <= LR
                       
    '// ban hay tao them 1 Button Reset de xoa het tat ca
    '// nhung ket qua da random nhe!
    '// code: range("D:D").ClearContents
End Sub

ducdoom ơi, trong đoạn code thuộc vòng lặp Do, có đoạn:

Mã:

indexRow = Int((lastRow - 2 + 1) * Rnd + 2)

bạn có thể giải thích thêm giúp mình ý nghĩa của việc cộng trừ được hog ah?

Cám ơn bạn nhiều.

VetMini · 14/7/19

ducdoom đã viết:

Xin chào!
gửi bạn code để bạn thử xem nhé!

Mã:

Private Sub UserForm_Initialize()
    'Su dung doi tuong "Me" de thay the cho ten UserForm
    Me.Top = Application.Top
    Me.Left = Application.Left
    Me.Height = Application.Height
    Me.Width = Application.Width
End Sub

Mã:

Private Sub Click_Here_Click()
    Dim wb As Workbook
    Set wb = Application.ThisWorkbook
    Dim ws As Worksheet
    Set ws = wb.Worksheets("List")
   
    Dim LR As Long
    LR = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
    Dim listRange As Range
    Set listRange = ws.Range("B2", "C" & LR)
   
    Dim indexRow As Long
    Dim Code As Variant
   
    Dim newRow As Long
    newRow = ws.Range("D" & ws.Rows.Count).End(xlUp).Row + 1
    If newRow > LR Then
        MsgBox "Ban da random het tat ca moi nguoi"
        Exit Sub
    End If
   
    Do
        indexRow = Int((LR - 2 + 1) * Rnd + 2)
        Code = ws.Range("B" & indexRow).Value2
       
        If ws.Range("D:D").Find(Code) Is Nothing Then
            textboxCode = Code
            textboxName = Application.WorksheetFunction.VLookup(Code, listRange, 2, 0)
            ws.Range("D" & newRow).Value2 = Code
            Exit Do
        End If
    Loop While newRow <= LR
                       
    '// ban hay tao them 1 Button Reset de xoa het tat ca
    '// nhung ket qua da random nhe!
    '// code: range("D:D").ClearContents
End Sub

Chủ bài #2:
Xổ số với code này nguy hiểm bỏ bố.

Vy Bui · 14/7/19

VetMini đã viết:
Chủ bài #2:
Xổ số với code này nguy hiểm bỏ bố.

Bạn có thể tư vấn thêm giúp mình code nào an toàn hơn được hog ah? Thanks

ducdoom · 14/7/19

VetMini đã viết:
Chủ bài #2:
Xổ số với code này nguy hiểm bỏ bố.

bác chỉ giúp em vấn đề nguy hiểm và hướng xử lý với.

ducdoom · 14/7/19

Vy Bui đã viết:
ducdoom ơi, trong đoạn code thuộc vòng lặp Do, có đoạn:

Mã:

indexRow = Int((lastRow - 2 + 1) * Rnd + 2)

bạn có thể giải thích thêm giúp mình ý nghĩa của việc cộng trừ được hog ah?

Cám ơn bạn nhiều.

Cái này mình cũng chỉ xem trên mạng thôi

Mã:

Int ((upperbound - lowerbound + 1) * Rnd + lowerbound)

Int ((6 - 1 + 1) * Rnd + 1)
Result: random number between 1 and 6

Int ((200 - 150 + 1) * Rnd + 150)
Result: random number between 150 and 200

Int ((999 - 100 + 1) * Rnd + 100)
Result: random number between 100 and 999

- Khi làm việc với số ngẫu nhiên trong VBA bạn nhớ thêm dòng Randomize ở đầu Sub như của bác Phuocam ở trên nhé
- Như code của mình không có Randomize thì hàm RND đại khái là sẽ ra kết quả gần giống với kết quả trước đó. (tính ngẫu nhiên sẽ thấp)
- Có Randomize thì kết quả sẽ ngẫu nhiên hơn!
-// Cảm ơn bác VetMini đã chỉ ra giúp mình//

ThangCuAnh · 14/7/19

Hàm VBA Randomize (rtcRandomize trong VBA) sẽ khởi tạo biến RandSeed toàn cục trong ruột của VBA với giá trị trả về từ hàm API GetTickCount. Hình như default nó là 0 hay 0xFFFFFFFF gì đó.
Gọi hàm VBA Rnd (rtcRandomNext trong VBA) thì trong ruột nó kiểm tra biến RandSeed toàn cục kia khởi tạo chưa, nếu rồi thì nó dùng biến RandSeed đó, không thì nó dựa trên 1 hằng cố định để sinh next random value. Hằng cố định là bao nhiêu thì quên rồi, cần thì tối về mở máy coi lại.
Vì vậy nếu gọi Rnd mà không có Randomize thì random value trả về sẽ có quy luật, có thể dò ra được.
Trong lãnh vực crypto, người ta hay bị lỗi và bị tấn công vì lỗi random đoán được này.
Vì vậy nhiều thư viện về crypto, người ta phải viết các hàm random rất phức tạp, để bảo đảm random value là duy nhất, không đoán được.

[UserForm] Rút thăm trúng thưởng (cơ bản) (1 người xem)

Người dùng đang xem chủ đề này

Vy Bui

Thành viên mới

File đính kèm

ducdoom

Thành viên chính thức

File đính kèm

Phuocam

Thành viên mới

File đính kèm

Vy Bui

Thành viên mới

Vy Bui

Thành viên mới

VetMini

Ăn cùng góc phố

Vy Bui

Thành viên mới

ducdoom

Thành viên chính thức

ducdoom

Thành viên chính thức

ThangCuAnh

Mới rờ Ét xeo

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

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

Đếm ngược thời gian