Điền giá trị ngẫu nhiên theo số lượng cho trước.

Em có bài toán sau nhờ các bác giúp đỡ với a.

Em có 11 con số tương ứng với số lần xuất hiện ngẫu nhiên vào một vùng có 10 hàng 10 cột.

Tao nut Click de moi lan Click se cho ra ket qua ngau nhien khac nhau.

Rất mong các bác viết code VBA giúp em ạ.

Em xin chân thành cảm ơn.!

1. Chuẩn bị: Tạo ra file có 2 sheet. Một sheet để ghi kết quả. Một sheet để nháp. Tên sheet ghi tùy ý. Sheet 1 là nơi tôi ghi kết quả. Sheet 2 là nơi tôi nháp.
Mình nghĩ nếu thao tác trên mảng thì nhanh hơn, nhưng thiếu trực quan với người mới học. Bản thân mình code cũng còn yếu. Vì vậy xin phép đi theo hướng này.
2. Thiết kế form:

2214
Trên ô C3 tôi dùng công thức SUM kiểm tra đầu vào có phải là 100 số hay không.
Nếu không phải thì thoát.

Tôi nghĩ code sẽ chặt chẽ hơn nếu kiểm tra xem có số nào có số lần là 0 hay không. Tuy nhiên việc này rườm rà mất thời gian, nên tôi mặc định số lần luôn là số nguyên dương.

3. Thuật toán:
Tôi đơn giản ghi các số theo số lần xuất hiện lên cột A của sheet 2.

2213
Cột B là nơi tôi tạo ra các số ngẫu nhiên.
Cột C là nơi tôi xếp thứ hạng từ cao xuống thấp dựa vào dãy số ngẫu nhiên trên cột B.
Dựa vào dữ liệu cột C tôi sẽ ghi kết quả số tương ứng ở cột A vào bảng kết quả.
Ví dụ: Dòng 19.
Số 0 có thứ hạng 73. Tôi mong mốn xếp số 0 này vào hàng 7, cột 3 trên bảng kết quả.
Kết quả:
2212
Để kiểm tra tính ngẫu nhiên, tôi chạy lại một lần nữa:
2211

4. Code:

Sub DienSoNgauNhien()
    Dim i   As Long, j As Long, cnt As Long
    Dim n   As Long
    Dim rend    As Long
    Dim arr
    Dim rng As Range
    Dim r As Long, r1 As Long, c As Long

Dim myDic As Object
    On Error Resume Next

With ThisWorkbook.Sheets(1)
        n = .Cells(1, 3) 'C1
        rend = .Cells(.Rows.Count, 1).End(3).Row
        arr = .Range(.Cells(2, 1), .Cells(rend, 2)).Value
    End With
    On Error GoTo 0
    If n <> 100 Then
        MsgBox "Kiem tra gia tri o C1"
        Exit Sub 'khong phai la 100 thi thoat
    End If

If rend < 2 Then
        MsgBox "Khong co du lieu tren cot A"
        Exit Sub
    End If

Set myDic = CreateObject("Scripting.Dictionary")

For i = LBound(arr, 1) To UBound(arr, 1) Step 1
        If Not myDic.Exists(arr(i, 1)) Then
            myDic.Add arr(i, 1), arr(i, 2)
        Else
            myDic.Item(arr(i, 1)) = myDic.Item(arr(i, 1)) + arr(i, 2)
        End If
    Next i
    'Xep ngau nhien
    arr = myDic.Keys
    cnt = 0
    On Error GoTo tiep
    With ThisWorkbook.Sheets(2)
        For i = LBound(arr) To UBound(arr) Step 1
            For j = 1 To myDic.Item(arr(i)) Step 1
                cnt = cnt + 1
                    .Cells(cnt, 1) = arr(i)
            Next j
tiep:
        Next i
    On Error GoTo 0
        If cnt = 0 Then Exit Sub
        Call Randomize 'Reset ngau nhien
        For i = 1 To cnt Step 1
            .Cells(i, 2) = Rnd
        Next i
        Set rng = .Range(.Cells(1, 2), .Cells(cnt, 2))
        For i = 1 To rng.Rows.Count
            .Cells(i, 3) = WorksheetFunction.Rank(.Cells(i, 2), rng)
        Next i
        arr = .Range(.Cells(1, 1), .Cells(cnt, 3)).Value
    End With
    'Ghi ket qua:
    With ThisWorkbook.Sheets(1)
        For i = LBound(arr, 1) To UBound(arr, 1) Step 1
            n = arr(i, 3)
            c = n Mod 10
            If c = 0 Then
                r1 = n / 10
                If r1 = 0 Then r1 = 1
            Else
                r1 = Int(n / 10) + 1
            End If

r = r1 + 1
            If c = 0 Then
                c = 13
            Else
                c = c + 3
            End If
            .Cells(r, c) = arr(i, 1)
        Next i
    End With
End Sub

Khóa học SprinGO phù hợp

Khóa học Power PI – Ứng dung trong Nhân sự

TỔNG QUAN KHÓA HỌC: POWER BI CHO NGÀNH NHÂN SỰ Khóa học Power BI cho Nhân sự được thiết kế dành riêng cho các...

Xem khóa học