Đ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
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: 35

Nhattanktnn

Thành viên tích cực
Tham gia ngày
11 Tháng mười một 2016
Bài viết
1,342
Được thích
1,238
Điểm
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 ạ.!).
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
 

Cu Tồ

Tìm đến kiến thức! ꧁༺ Cu Tồ ༻꧂
Tham gia ngày
6 Tháng năm 2020
Bài viết
720
Được thích
340
Điểm
168
chờ mãi mới có " cao nhân " vào để xem cái code
 

CHAOQUAY

Thành viên tích cực
Tham gia ngày
24 Tháng tám 2018
Bài viết
1,385
Được thích
1,506
Điểm
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 ạ.!).
Bạn muốn có tất cả các đáp án hay là 1?
 

VetMini

Chuyên gia GPE
Tham gia ngày
21 Tháng mười hai 2012
Bài viết
10,789
Được thích
13,274
Điểm
4,868
A cái này là đánh Keno đây mà.
Nhưng mà cỡ mình là nhất lưu rồi, gọi cao nhân chưa xứng, hỏng thèm làm.
 

sangucu1

Thành viên mới
Tham gia ngày
26 Tháng mười một 2020
Bài viết
11
Được thích
4
Điểm
3
Tuổi
41
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
Anh oi chieu em log acc em bang dong bo email. Ko hieu sao gio ko log dc nua.
Anh up len giup em di a
Bài đã được tự động gộp:

Bạn muốn có tất cả các đáp án hay là 1?
Anh oi em muon tao nut click de moi lan kick chuot se cho mot phuong an ngau nhien khac nhau a
 

VetMini

Chuyên gia GPE
Tham gia ngày
21 Tháng mười hai 2012
Bài viết
10,789
Được thích
13,274
Điểm
4,868
Thứ nhất là sửa tiêu đề như bài #2 đề nghị.
Thứ hai là đợi bao giờ gõ được tiếng có dấu rồi nói chuyện tiếp.
 

Trần Nhật Anh

Thành viên mới
Tham gia ngày
7 Tháng mười 2020
Bài viết
18
Được thích
13
Điểm
0
Tuổi
16
Nơi ở
BR-VT
A cái này là đánh Keno đây mà.
Nhưng mà cỡ mình là nhất lưu rồi, gọi cao nhân chưa xứng, hỏng thèm làm.
Nhf
A cái này là đánh Keno đây mà.
Nhưng mà cỡ mình là nhất lưu rồi, gọi cao nhân chưa xứng, hỏng thèm làm.
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?
Em ứng trước 100k, nếu thua em vẫn mời Bác 1 café đá nha!
Quê em café đá giá 10k
Chúc Bác cuối tuần vui vẻ
 

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
Thứ nhất là sửa tiêu đề như bài #2 đề nghị.
Thứ hai là đợi bao giờ gõ được tiếng có dấu rồi nói chuyện tiếp.
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 ạ.
 

ndu96081631

Huyền thoại GPE
Thành viên BQT
Super Moderator
Tham gia ngày
5 Tháng sáu 2008
Bài viết
30,725
Được thích
53,555
Điểm
50
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 ạ.!).
Viết đại code thế này:
Mã:
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 Sub
Không biết có chỗ nào sai không nữa???!!!
Bạn kiểm tra xem!
 

File đính kèm

  • chọn ngẫu nhiên.xlsm
    19.2 KB · Đọc: 30

VetMini

Chuyên gia GPE
Tham gia ngày
21 Tháng mười hai 2012
Bài viết
10,789
Được thích
13,274
Điểm
4,868
. .
Mã:
Sub 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 Sub
 

excel_lv1.5

Thành viên tích cực
Tham gia ngày
20 Tháng mười 2017
Bài viết
826
Được thích
1,469
Điểm
568
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 ạ.!).
Một cách dùng Power query, chuột phải bấm refresh!
 

File đính kèm

  • chọn ngẫu nhiên.xlsx
    20.8 KB · Đọc: 22

Nhattanktnn

Thành viên tích cực
Tham gia ngày
11 Tháng mười một 2016
Bài viết
1,342
Được thích
1,238
Điểm
668
Anh oi chieu em log acc em bang dong bo email. Ko hieu sao gio ko log dc nua.
Anh up len giup em di a
Như đã hứa, tuy code cùi nhưng cũng là một cách bạn tham khảo:
Mã:
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 Sub
 

File đính kèm

  • chọn ngẫu nhiên.xlsm
    18.7 KB · Đọc: 21

phuocam

Thành viên mới
Tham gia ngày
16 Tháng năm 2013
Bài viết
2,924
Được thích
4,089
Điểm
1,568
Hãy thử với dữ liệu:
Số 6090
Số 581
Số 551
Số 521
Số 491
Số 451
Số 411
Số 371
Số 331
Số 301
Số 01

Nếu có số khác "Số 60" có thể xuất hiện ngẫu nhiên trong dòng 10 là ngon lành.
 

sangucu1

Thành viên mới
Tham gia ngày
26 Tháng mười một 2020
Bài viết
11
Được thích
4
Điểm
3
Tuổi
41
Như đã hứa, tuy code cùi nhưng cũng là một cách bạn tham khảo:
Mã:
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 Sub

Thank you very much.!
Happy weekend to you...
Bài đã được tự động gộp:

Viết đại code thế này:
Mã:
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 Sub
Không biết có chỗ nào sai không nữa???!!!
Bạn kiểm tra xem!

Em cam on bac aj.
 

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
Như đã hứa, tuy code cùi nhưng cũng là một cách bạn tham khảo:
Mã:
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 Sub
Bá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.
Bài đã được tự động gộp:

Viết đại code thế này:
Mã:
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 Sub
Không biết có chỗ nào sai không nữa???!!!
Bạn kiểm tra xem!
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 ạ
 

Nhattanktnn

Thành viên tích cực
Tham gia ngày
11 Tháng mười một 2016
Bài viết
1,342
Được thích
1,238
Điểm
668
Bá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.
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"
6010
589
559
529
499
459
419
379
339
309
09
 

CHAOQUAY

Thành viên tích cực
Tham gia ngày
24 Tháng tám 2018
Bài viết
1,385
Được thích
1,506
Điểm
668
@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
 

File đính kèm

  • chọn ngẫu nhiên (1).xlsm
    24.6 KB · Đọc: 12
Quảng cáo
Top Bottom