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

Liên hệ QC

sangucu

Thành viên mới
Tham gia
29/3/19
Bài viết
6
Được thích
0
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 ạ.!).
 

File đính kèm

  • chọn ngẫu nhiên.xlsb.xlsx
    9 KB · Đọc: 46
@sangucu
Thử code abc trong file đính kèm
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.
 
Upvote 0
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
Mã:
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
 

File đính kèm

  • chọn ngẫu nhiên.xlsm
    17 KB · Đọc: 26
Upvote 0
Thử bằng công thức:
 

File đính kèm

  • chọn ngẫu nhiên_ok.xlsx
    20.7 KB · Đọc: 18
Lần chỉnh sửa cuối:
Upvote 0
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
Mã:
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))))
 
Upvote 0
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
Mã:
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 :eek::eek:
 
Upvote 0
Web KT

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

Back
Top Bottom