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

Quảng cáo

sangucu

Thành viên mới
Tham gia ngày
29 Tháng ba 2019
Bài viết
6
Được thích
0
Điểm
101
Tuổi
41
@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.
 

HieuCD

Chuyên gia GPE
Tham gia ngày
14 Tháng chín 2010
Bài viết
7,482
Được thích
14,945
Điểm
4,668
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: 19

dazkangel

<New Horizons>
Tham gia ngày
28 Tháng hai 2017
Bài viết
2,915
Được thích
3,899
Điểm
1,368
Nơi ở
Đồng Nai
Thử bằng công thức:
 

File đính kèm

  • chọn ngẫu nhiên_ok.xlsx
    20.7 KB · Đọc: 11
Lần chỉnh sửa cuối:

HieuCD

Chuyên gia GPE
Tham gia ngày
14 Tháng chín 2010
Bài viết
7,482
Được thích
14,945
Điểm
4,668
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))))
 

dazkangel

<New Horizons>
Tham gia ngày
28 Tháng hai 2017
Bài viết
2,915
Được thích
3,899
Điểm
1,368
Nơi ở
Đồng Nai
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:
 
Quảng cáo
Top Bottom