Xin giúp hàm chọn ngẫu nhiên

Liên hệ QC

mymapmap

Thành viên hoạt động
Tham gia
4/5/09
Bài viết
167
Được thích
24
Nghề nghiệp
KTV Điện tử
Mình muốn chọn ngẫu nhiên trong một danh sách lớn ra một danh sách con.
VD: cột B có danh sách 90 học sinh mình muốn trích ra ngẫu nhiên một danh sách con 15 học sinh bỏ vào cột C chẳng hạn
Cột dữ liệu nguồn (B) và cột dữ liệu đến (C) và số phần tử con (15) là tùy chọn.
Xin các Thầy giúp mình hàm này với. Xin Cảm ơn nhiều.
 
Bằng 1 macro, chịu không?

PHP:
Option Explicit
Sub SoNgau()
 Dim Clls As Range, MyColor As Byte
 
 [B1].Value = "Randomize"
 With [B1].Interior
   If .ColorIndex < 34 Then MyColor = 35 Else MyColor = .ColorIndex + 1
 End With
 For Each Clls In Range([A2], [A65500].End(xlUp))
   Randomize:           Clls.Offset(, 1).Value = Rnd()
 Next Clls
 Columns("A:B").Sort Key1:=[B2], Order1:=xlDescending, Header:=xlGuess
 If MyColor = 42 Then MyColor = 34
 [B1].Interior.ColorIndex = MyColor
End Sub
(*) Danh sách HS của bạn tại cột 'A' & chạy macro
 
Upvote 0
Sao cột B chỉ là số ngẫu nhiên của cột A không thôi vậy? làm như thế nào để in ra danh sách con ngẫu nhiên trong danh sách học sinh lớn lúc đầu.
Xin cảm ơn các thầy đã quan tâm giúp.
 
Upvote 0
Làm như thế nào để in ra danh sách con ngẫu nhiên trong danh sách học sinh lớn lúc đầu.
Xin cảm ơn các thầy đã quan tâm giúp.

Bạn có thể chép (Bằng tay hay bằng macro) sang trang tính khác hay vùng khác để in.

Số lượng chép có thể là tuỳ hứng.

Nếu cần, chúng ta sẽ tiếp bằng file giả lập của bạn.
 
Upvote 0
Theo ý câu hỏi, vì không có file
PHP:
Sub RandomHS()
Dim i As Long, EndR As Long, solan As Long
Dim MyArr() As String, Rand1 As Long
  Range("c2:C100").Clear
  ReDim MyArr([c1].Value, 1)
  EndR = [A1000].End(xlUp).Row - 1
   For i = 1 To [c1].Value
     Rand1 = Int(Rnd() * (EndR - 1)) + 2
     MyArr(i, 1) = Cells(Rand1, 2).Value
   Next
  Range("C2:C" & [c1].Value + 1) = MyArr
  solan = solan + 1

  If [d1] < [c1] Then
     RandomHS
  Else
     MsgBox "Da chay " & solan & "lan." & _
     Chr(10) & "Nho nhan thank lao chet tiet!"
     solan = 0
  End If
End Sub
 

File đính kèm

Upvote 0
Mình muốn chọn ngẫu nhiên trong một danh sách lớn ra một danh sách con.
VD: cột B có danh sách 90 học sinh mình muốn trích ra ngẫu nhiên một danh sách con 15 học sinh bỏ vào cột C chẳng hạn
Cột dữ liệu nguồn (B) và cột dữ liệu đến (C) và số phần tử con (15) là tùy chọn.
Xin các Thầy giúp mình hàm này với. Xin Cảm ơn nhiều.
Xin góp một cách
Mã:
Public Sub ngaunhien()
  Dim i, j As Integer, vung, dk As Range
    Set vung = Range([a2], [a2].End(xlDown))
    [c1] = "Ket qua"
    Range("c2:c100").ClearContents
      For j = 1 To vung.Rows.Count
       Set dk = Range([c1], [c20].End(xlUp))
        If dk.Rows.Count = 16 Then Exit Sub
         i = Int(Rnd() * 90)
         If Application.WorksheetFunction.CountIf(dk, vung(i)) = 0 Then [c20].End(xlUp).Offset(1, 0) = vung(i)
      Next
End Sub
Dữ liệu nguồn ở cột A, kết quả ở cột C
Bấm ctrl + W để chạy code
 

File đính kèm

Upvote 0
Chọt Cò già miếng:
Với:

i = Int(Rnd() * 90)

i không bao giờ bằng 90, nên em học sinh mang số thứ tự 90 (trở về sau nếu có) không bao giờ được chọn đi dự sinh nhật GPE. Tội nghiệp em í quá.
 
Upvote 0
Chọt Cò già miếng:
Với:

i = Int(Rnd() * 90)

i không bao giờ bằng 90, nên em học sinh mang số thứ tự 90 (trở về sau nếu có) không bao giờ được chọn đi dự sinh nhật GPE. Tội nghiệp em í quá.
Híc, cứ lo kiếm cách đơn giản loại cái ngẫu nhiên nhưng trùng lại quên mất cái này, thôi thì cứ cho thằng thứ 90 nó thoát(đề bài chỉ cho 90 "thằng" thôi Thầy ạ, nếu danh sách chưa biết mình khai báo khác chứ), còn hông Thầy sửa lại chỗ code đó một tý tẹo giúp mình (ai biểu "chọt" làm chi, "chọt" rồi thì phải sửa giúp một tí) cho "ẻm" 90 dính líu vào
Híc, cứ lo ăn nhậu, chẳng chịu tu luyện bị Thầy "chọt" hoài
Hãy đợi đấy
Vẫn ..híc
 
Upvote 0
SPAM 1 cái:

Thì thêm dòng lệnh ni vô:
PHP:
  i = i +1
là đủ chứ chi mô rứa hè!
 
Upvote 0
nếu thêm i = i + 1 vậy có lấy ngẫu nhiên phần tử đầu tiên được không thầy?
Xin chỉ giúp.
Cảm ơn!
 
Upvote 0
i = Int(Rnd() * 90) +1

- Rnd() là 1 số ngẫu nhiên trong khoảng 0 < i < 1 tức là không bằng 0 cũng không bằng 1.
- Rnd() *90 sẽ ra 1 số 0< R < 90 (không bằng 0 cũng không bằng 90, nhỏ nhất thì nhỏ hơn 1, lớn nhất là 89,9999...)
- Int(Rnd() * 90) sẽ lấy phần nguyên, sẽ có các giá trị từ 0 đến 89
- nếu cộng 1 vào sẽ có các giá trị từ 1 đến 90

Vậy, bắt buộc phải cộng 1 vào nếu muốn lấy giá trị cuối. Nếu không cộng vào, không có giá trị cuối mà sẽ lấy cả giá trị 0. Trong excel, khi dùng 0 để xác định địa chỉ dòng, cột sẽ bị lỗi.
 
Upvote 0
Bạn tự kiểm nghiệm theo kết quả từ macro này xem sao

PHP:
Option Explicit
Sub SoNgau1()
 Dim jJ As Long, Xx As Long, Yy As Byte
 Dim Cls As Range
 Xx = 0: Yy = 5
 Set Cls = Cells(1, "E")
 For jJ = 1 To 33 * 18
   Xx = Xx + 1
   If Xx > 33 Then
      Xx = 1: Yy = Yy + 1
   End If
   Randomize
   Cls.Cells(Xx, Yy).Value = 1 + Int(80 * Rnd())
 Next jJ
End Sub

Tặng bạn luôn fần bổ sung đễ bạn khỏi tự đếm các số 1

PHP:
Option Explicit
Sub SoNgau1()
 Dim jJ As Long, Xx As Long, Yy As Byte
 Dim Cls As Range, Rng As Range
 Dim MyAdd As String
 
 Xx = 0: Yy = 5
 Set Cls = Cells(1, "E")
 For jJ = 1 To 33 * 18
   Xx = Xx + 1
   If Xx > 33 Then
      Xx = 1: Yy = Yy + 1
   End If
   Randomize
   Cls.Cells(Xx, Yy).Value = 1 + Int(80 * Rnd())
 Next jJ
 Set Rng = Cls.CurrentRegion
 Set Cls = Rng.Find(1, , xlFormulas, xlWhole)
 If Not Cls Is Nothing Then
   Xx = 0:        MyAdd = Cls.Address
   Do
      Xx = Xx + 1
      Set Cls = Rng.FindNext(Cls)
   Loop While Not Cls Is Nothing And Cls.Address <> MyAdd
 End If
 MsgBox Xx
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
PHP:
Bạn tự kiểm nghiệm theo kết quả từ macro này xem sao[/QUOTE]

Sao không làm vầy nè Bác:

[php]Option Explicit
Sub SoNgau2()
 Dim  Xx As Long, Yy As Byte
 For Xx = 1 To 33 
   For Yy = 1 to 18
      Randomize
      Cells(Xx, Yy).Value = 1 + Int(80 * Rnd())
 Next Yy, Xx
End Sub

Nếu dùng biến mảng còn nhanh hơn nữa. Nhưng chủ yếu là em cháu nào mới học VBA đọc code hiểu liền.
 
Lần chỉnh sửa cuối:
Upvote 0
Bác chọt em chỗ nào em sai thì em chịu, chọt chỗ em dốt không biết thì rứa rứa thôi.

Zậy trả lại Bác 1 gậy (chọt gậy bánh xe đó mà):

Để đếm số 1, à mà đếm luôn số 80 cho nó có đầu có đuôi, em dùng cái ni, bảo đảm ai cũng hiểu, mà ngắn ngủn hè, khỏi lặp Do loop:

PHP:
MsgBox "Co " & Application.CountIf([A1].CurrentRegion, 1) & " so 1" & _
Chr(10) & "va " & Application.CountIf([A1].CurrentRegion, 80) & " so 80"

Tính nguyên code thì có xíu xiu như ri:
PHP:
Option Explicit
Sub SoNgau2()
 Dim Xx As Long, Yy As Byte
 For Xx = 1 To 33
   For Yy = 1 To 18
      Randomize
      Cells(Xx, Yy).Value = 1 + Int(80 * Rnd())
 Next Yy, Xx
 MsgBox "Co " & Application.CountIf([A1].CurrentRegion, 1) & " so 1" & _
 Chr(10) & "va " & Application.CountIf([A1].CurrentRegion, 80) & " so 80"

End Sub
 
Upvote 0
Web KT

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

Back
Top Bottom