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

[sangucu]

@sangucu
Thử code abc trong file đính kèm

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

Em cảm ơn anh ạ.
Code hoàn hảo rồi anh.

 

[HieuCD]

Em kính chào các bá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.

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

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

(file đính kèm của em dưới đây ạ.!).

Chạy code

Sub ABC()
  Dim sArr(), Arr(), Res(), N&, i&, RndNum&, k&
 
  sArr = Range("A2:B12").Value
  N = 100
  ReDim Arr(1 To N)
  ReDim Res(1 To 10, 1 To 10)
 
  Randomize
  For i = 1 To UBound(sArr)
    For r = 1 To sArr(i, 2)
      RndNum = Int(N * Rnd() + 1)
      If Arr(RndNum) = Empty Then k = RndNum Else k = Arr(RndNum)
      Res(Int((k - 1) / 10) + 1, ((k - 1) Mod 10) + 1) = sArr(i, 1)
      If Arr(N) = Empty Then Arr(RndNum) = N Else Arr(RndNum) = Arr(N)
      N = N - 1
    Next r
  Next i
  Range("D2:M11").Value = Res
End Sub

 

[dazkangel]

Thử bằng công thức:

 

[HieuCD]

Có ai giải thích giùm em sao nó bị lỗi được nhỉ ?

MIN(ROWS($B$2:$B$12),SUM($B$2:$B$12)-COUNTA($E3:E3,$F$2:$O2))
Không loại được các dòng đã lấy hết số lượng

F3 =SMALL(IF(IFERROR(FREQUENCY(($E3:E3,$F$2:$O2),$A$2:$A$12)<$B$2:$B$12,FALSE),$A$2:$A$12),RANDBETWEEN(1,SUM(--IFERROR(FREQUENCY(($E3:E3,$F$2:$O2),$A$2:$A$12)<$B$2:$B$12,FALSE))))

 

[dazkangel]

MIN(ROWS($B$2:$B$12),SUM($B$2:$B$12)-COUNTA($E3:E3,$F$2:$O2))
Không loại được các dòng đã lấy hết số lượng

F3 =SMALL(IF(IFERROR(FREQUENCY(($E3:E3,$F$2:$O2),$A$2:$A$12)<$B$2:$B$12,FALSE),$A$2:$A$12),RANDBETWEEN(1,SUM(--IFERROR(FREQUENCY(($E3:E3,$F$2:$O2),$A$2:$A$12)<$B$2:$B$12,FALSE))))

Em giải quyết xong rồi