Code xong rồi, sửa tiêu đề "Điền giá trị ngẫu nhiên với số lượng cho trước" xong mình gửi code lên
Bạn muốn có tất cả các đáp án hay là 1?
Anh oi chieu em log acc em bang dong bo email. Ko hieu sao gio ko log dc nua.
Anh oi em muon tao nut click de moi lan kick chuot se cho mot phuong an ngau nhien khac nhau a
danh Keno la gi anh? Anh giup em di a
Nhf
Nhờ Bác xuất chiêu cho Em thử thời vận, nếu thắng 50-50 được không Bác?
Híc,,, em log lại bằng máy tính của em thì sửa được tiêu đề rồi và viết có dấu được rồi đây ạ? Bác ra tay giúp em vì đam mê học hỏi thôi chứ ko ham hố hay dụ dỗ gì đâu ạ.
Viết đại code thế này:
Sub Test()
Dim arr
Dim idx As Long
Dim lPos As Long
Dim lNewTop As Long
Dim lR As Long
Dim lC As Long
arr = Sheet1.Range("A2:B12").Value
ReDim aDes(1 To 10, 1 To 10)
lNewTop = 11
Randomize
Do
lPos = Int(Rnd() * lNewTop) + 1
idx = idx + 1
lR = Int((idx - 1) / 10) + 1
lC = ((idx - 1) Mod 10) + 1
aDes(lR, lC) = arr(lPos, 1)
If arr(lPos, 2) > 0 Then arr(lPos, 2) = arr(lPos, 2) - 1
If arr(lPos, 2) <= 0 Then
arr(lPos, 1) = arr(lNewTop, 1)
arr(lPos, 2) = arr(lNewTop, 2)
lNewTop = lNewTop - 1
End If
Loop Until lNewTop = 0
Range("D2:M11").Value = aDes
End SubSub t()
Const SOLUONG = 100
Const SODONG = 10
Const SOCOT = 10
Dim b(1 To SODONG, 1 To SOCOT) ' mang ket qua
a = Range("a2").Resize(11, 2).Value ' doc du lieu
For i1 = 1 To 11
a1 = Val(Split(a(i1, 1), " ")(1)) ' so can lay
a2 = Val(Split(a(i1, 2), " ")(0)) ' so luong can lay
tongSoLan = tongSoLan + a2
If tongSoLan > SOLUONG Then
MsgBox "nhieu qua, vuot so luong toi da"
Exit For
End If
For i2 = 1 To a2
p = Application.RandBetween(1, SOLUONG) ' vi tri so
' nhet vao mang b
Do While True
p1 = (p - 1) \ SOCOT + 1 ' dong
p2 = p - (p1 - 1) * SOCOT ' cot
If CStr(b(p1, p2)) = "" Then ' vi tri con trong
b(p1, p2) = (a1)
Exit Do
End If
p = IIf(p >= SOLUONG, 1, p + 1) ' thu vi tri ke tiep
Loop
Next i2
Next i1
Range("D2").Resize(SODONG, SOCOT).Value = b
End SubMột cách dùng Power query, chuột phải bấm refresh!
Như đã hứa, tuy code cùi nhưng cũng là một cách bạn tham khảo:
Option Explicit
Sub Random()
Dim I As Long, iMax As Long, iMin As Long, a As Long, b As Long, c As Long
Dim R As Long, Rng As Range, Cll As Range, RngF As Range
Application.ScreenUpdating = False
iMax = Application.Max(Range("A2:A12"))
iMin = Application.Min(Range("A2:A12"))
Set Rng = [D2:M11]
Rng.ClearContents
For Each Cll In Rng
c = 0
Do
a = Application.RandBetween(iMin, iMax)
Set RngF = Range("A2:A12").Find(a, , , xlWhole)
If Not RngF Is Nothing Then
b = WorksheetFunction.CountIf(Rng, a)
c = RngF.Offset(, 1).Value
End If
Loop Until Not RngF Is Nothing And b <= c - 1
Cll = a
Next
Application.ScreenUpdating = True
End SubBác ơi, tỷ lệ số 0 xuất hiện ở hàng dưới cùng cao bất thường. Bác check lại code giúp em với.
Code của bác cũng bị hiện tượng số 0 xuất hiện ở hàng dưới cùng quá cao ạ
Chắc do số 0 nhiều quá nên mỗi lần random nó ra số khác nhau, lần này ra số 0 rồi thì tỷ lệ lần sau ra số 0 ít đi, do đó cuối cùng khi các số kia đủ rồi thì lòi ra số 0 nhiều nhất. bạn thử cho số liệu như này sẽ thấy rất là "ngẫu nhiên"
| 60 | 10 |
| 58 | 9 |
| 55 | 9 |
| 52 | 9 |
| 49 | 9 |
| 45 | 9 |
| 41 | 9 |
| 37 | 9 |
| 33 | 9 |
| 30 | 9 |
| 0 | 9 |
Option Explicit
Sub abc()
Dim Nguon
Dim Mang
Dim Kq
Dim dau, slD
Dim i, j, k, x, z, t
Nguon = Sheet1.Range("A2:B12")
slD = UBound(Nguon)
ReDim Mang(1 To 100)
ReDim Kq(1 To 10, 1 To 10)
Randomize
dau = Int(Rnd() * (slD - 1)) + 1
For i = dau To dau + slD - 1
k = ((i - 1) Mod slD) + 1
For j = 1 To Nguon(k, 2)
t = t + 1
Mang(t) = Nguon(k, 1)
Next j
Next i
For z = 100 To 1 Step -1
k = Int(Rnd() * (z - 1)) + 1
i = Int((z - 1) / 10) + 1
j = ((z - 1) Mod 10) + 1
Kq(i, j) = Mang(k)
Mang(k) = Mang(z)
Next z
With Sheet1
.Range("D2").Resize(10, 10).ClearContents
.Range("D2").Resize(10, 10) = Kq
.Range("D2").Resize(10, 10).Borders.LineStyle = 1
End With
End Sub
