Tạo dãy số ngẫu nhiên không trùng

Liên hệ QC

anhtuan1066

Thành viên gạo cội
Tham gia
10/3/07
Bài viết
5,802
Được thích
6,905
Trên diển đàn GPE đã có rất nhiều bài viết nói về vấn đề này!
Tôi cũng đã tham khảo rất nhiều code ở các trang nước ngoài nhưng thấy rằng hầu hết đều viết rất khó hiểu và dài dòng!
Trong 1 dịp tình cờ khi nghiên cứu về Dictionary Object, tôi nhận thấy rằng nó có khả năng làm được điều này mà code lại cực kỳ đơn giản
Thuật toán dựa vào định nghĩa của Dictionary có đoạn: Key là những phần tử duy nhất trong Keys
Tôi đã xây dựng code như sau:
PHP:
Function UniqueRandomNum(Bottom As Long, Top As Long, Amount As Long)
  'Application.Volatile '<--- Neu muon gia tri thay doi khi bam F9
  On Error Resume Next
  If Amount > Top - Bottom + 1 Then Amount = Top - Bottom + 1
  With CreateObject("Scripting.Dictionary")
    Do
      .Add Int(Rnd() * (Top - Bottom + 1)) + Bottom, ""
    Loop Until .Count = Amount
    UniqueRandomNum = WorksheetFunction.Transpose(.Keys)
  End With
End Function
Cú pháp hàm:
PHP:
=UniqueRandomNum(Số nhỏ, Số lớn, bao nhiêu số cần tạo)
Giả sử các bạn muốn tạo ra 30 số ngẩu nhiên không trùng nằm trong khoảng từ 1 đến 100, các bạn làm như sau:
- Quét chọn 30 cell tùy ý theo chiều dọc, chẳng hạn là A1:A30
- Gõ vào thanh Formula công thức =UniqueRandomNum(1,100,30)
- Bấm tổ hợp phím Ctrl + Shift + Enter
Hãy thí nghiệm với đoạn Test sau:
PHP:
Sub Test()
  Range("A1:A30").Value = UniqueRandomNum(1, 100, 30)
End Sub
--------------
Ghi chú: Dictionary Object còn làm được nhiều thứ khác nữa, chẳng hạn có thể xây dựng hàm trích lọc các phần tử duy nhất (ngẫu nhiên và duy nhất đã làm được, đương nhiên duy nhất sẽ càng dể hơn)
 

File đính kèm

  • GetUniqueRandNum.xls
    24 KB · Đọc: 4,046
Lần chỉnh sửa cuối:
Tôi xin giả lập 1 file, dùng ứng dụng trên để tạo phòng thi
- Có 146 sinh viên
- Tạo 5 phòng thì, mỗi phòng 30 sinh viên được lấy ngẫu nhiên từ dử liệu gốc
Xem file
 

File đính kèm

  • Chiaphongthi.xls
    44 KB · Đọc: 2,299
Upvote 0
UniqueRandomNum

làm sao viết được đoạn code này cho excel 2007 vậy bác ơi.
em dowload file về thì dùng dược hưng dùng hàm UniqueRandomNum thì kô có trong excel
em mong bác chỉ cho em cách tạo để có thể dùng ở mọi nơi.
em cám ơn bác rất nhiều.

 
Upvote 0
làm sao viết được đoạn code này cho excel 2007 vậy bác ơi.
em dowload file về thì dùng dược hưng dùng hàm UniqueRandomNum thì kô có trong excel
em mong bác chỉ cho em cách tạo để có thể dùng ở mọi nơi.
em cám ơn bác rất nhiều.
- Bạn mở file tác giả lên, bấm Alt + F11 vào xem người ta viết code gì trong đó
- Copy toàn bộ code
- Mở file của bạn lên, cũng bấm Alt + F11 rồi paste code đã copy vào (y chang file gốc)
Lưu ý: Code này đặt trong 1 Module, vậy bạn cũng phải vào menu Insert\Module (để có 1 Module như người ta) rồi hẳn paste code vào
 
Upvote 0
Hàm của bác Tuấn lạ ghê mà độc đáo nữa.
 
Upvote 0
Lọc danh sách

Em cố tự làm nhưng tay nghề em yếu quá. mong các anh chị giúp em lấy ra 1 lần 50 tên nhé.Nhưng phải ngẫu nhiên và những lần như vậy không được trùng nhau nhé. em post lên file excel này mong các anh chị giúp đỡ em nhé, Em chân thành cám ơn
 
Lần chỉnh sửa cuối:
Upvote 0
1- Phải tạo một Object Dictionary
2- Phải thêm bẫy lỗi: On Error Resume Next vì Dictionary.Add sẽ bị trùng Key do ngẫu nhiên

Chúng ta có thể viết code cũng đơn giản thôi, dễ hiểu, không bẫy lỗi, không dùng Dic như sau:
(code trên viết lại, một số biến thay đổi tên)
Mã:
Function RandNum(Btom As Long, Top As Long, Amount As Long)
ReDim aa(Amount) As Long
     Do
        bb = Int(Rnd() * (Top - Btom + 1)) + Btom
        If InStr(cc, "@" & bb & "@") = 0 Then
            aa(i) = bb
            cc = cc & "@" & bb & "@"
            i = i + 1
        End If
    Loop Until i = Amount
    RandNum = WorksheetFunction.Transpose(aa)
 End Function
Hãy dùng code của bạn tạo ra 60000 số ngẫu nhiên trên bảng tính, từ 1 đến 100000 ---> Làm xong xem thử tốc độ code của bạn là bao nhiêu giây rồi hẳn bàn tiếp nhé
(Tốc độ chạy code của "người ta" là < 1 giây đấy ---> Còn của bạn = ? )
 
Lần chỉnh sửa cuối:
Upvote 0
1- Đúng là code của tôi chậm hơn do thao tác trên string với số lượng rất lớn, nhưng nó vẫn tốt khi tạo vài trăm số ngẫu nhiên.
2- Sở dĩ tôi viết hàm trên vì tôi đã trích dẫn lý do: tác giả bảo "...các trang nước ngoài nhưng thấy rằng hầu hết đều viết rất khó hiểu và dài dòng!", tôi chỉ chứng minh rằng ta vẫn có thể viết code gọn và dễ hiếu
3- Mong GPE với tinh thần xây dựng là chính, các trao đổi nên dựa trên học thuật.
* Ưu điểm của Dictionary là không có key trùng; dựa trên đấy tác giả anhtuan1066 viết function ngắn gọn; tuy nhiên việc bẫy lỗi "On Error Resume Next" về phương diện học thuật không phải ai cũng thích (mặc dù nhìn vào code, lỗi chỉ xẩy ra trong vòng lặp đã tiên liệu)
* Ta có thể loại câu "On Error Resume Next" như sau:
Mã:
Function RandNum2(Btom As Long, Top As Long, Amount As Long)
Set aa = CreateObject("Scripting.Dictionary")
1:  Do
        bb = Int(Rnd * (Top - Btom + 1)) + Btom
        If aa.Exists(bb) Then GoTo 1
        aa.Add bb
    Loop Until aa.Count = Amount
    RandNum2 = WorksheetFunction.Transpose(aa)
 End Function
Xin ngừng ngang đây. cảm ơn các bạn đã góp ý
1> Không phải là CHẬM HƠN mà gọi là QUÁ QUÁ.. CHẬM mới đúng ----> Trong 1 chương trình hoàn chỉnh thường có nhiều module, và trong từng module người ta hơn thua nhau từng ms một (chứ tốc độ rùa thế thì.. không ăn thua)
2> Dictionary Object là món chuyên về Unique rồi ---> Thiết nghĩ chẳng cần phải "cải biên" thêm làm gì ----> Chẳng ai lại đi bỏ cái "sở trường" mà đi dùng cái "sở đoản" cho mất công
3> Cái vụ On Error Resume Next chẳng qua là "người ta" quá hiểu lỗi có thể xuất hiện ở đây là gì rồi ---> Nếu viết cho rõ thì vầy:
PHP:
Function UniqueRandomNum(Bottom As Long, Top As Long, Amount As Long)
  Dim Tmp as Long
  'Application.Volatile '<--- Neu muon gia tri thay doi khi bam F9
  If Amount > Top - Bottom + 1 Then Amount = Top - Bottom + 1
  With CreateObject("Scripting.Dictionary")
    Do
      Tmp = Int(Rnd() * (Top - Bottom + 1)) + Bottom
      If Not .Exists(Tmp) then .Add Tmp, ""
    Loop Until .Count = Amount
    UniqueRandomNum = WorksheetFunction.Transpose(.Keys)
  End With
 End Function
4> Xét về mặt "dễ hiểu" thì cũng không chắc code của bạn đã dễ hiểu hơn đâu (thuật toán dạng này đã từng có trên diễn đàn rồi)
-----------------------------
Bạn còn ý kiến gì khác hơn không? Tôi rất mong có thể học hỏi thêm những điều mới lạ (mà tôi chưa biết) từ bạn
 
Upvote 0
Theo tôi, cách nào cũng có cái hay của nó. Nếu là tôi, viết nhanh thì cũng viết theo bạn Ba3ba3. Và bạn nào muốn tập viết code thì cũng chưa nghĩ ra Dic, thú thật là cũng hơi cao.
Đề nghị Bác NDU khi có chiêu nào mới thì nên viết dài một chút cho mọi người dễ hiểu và dễ test.
Thú thật là mình chả thích vòng Do ... loop và "On Error Resume Next" lắm.
Cám ơn NDU. Cám ơn Ba3ba3.
 
Upvote 0
Collection Object
Mới về xem bài này, rất lo lắng, đành phải viết bài chữ được chữ mất. Sợ rằng 2 bạn lại escape luôn thì lại ...
Nay lại biết thêm
"Collection Object", tôi hưa rằng sẽ test thử. Cám ơn Ba3Ba3, nên bỏ bớt 1 số 3 là quá đã.
Thú thật nhờ sự tranh cãi như vậy mà tôi nắm bắt thêm nhiều chiêu.
Xin rằng 2 bạn vẫn vậy như bỏ qua mấy câu cảm thán nhé.
Cám ơn 2 bạn rất nhiều. Mong rằng mình sẽ có nhiều bài từ 2 bạn. mình thấy
Ba3Ba3 cũng là chuyên giá nhất là về array, mình đang mê món này lắm chỉ chưa đủ khả năng chứng tỏ là nó hay thế nào.
Thứ lỗi giúp vì mình nói sai.


 
Upvote 0
Đã từ lâu, giờ thấy lại collection

ngoài ra còn có Collection Object, mà Collection thì khỏi dùng hàm CreateObject, chỉ việc khai báo biến thường lệ; sau đây tôi sẽ viết với Collection

Từ khi GPE chưa sinh ra mình đã thấy đâu đó Collection Object; Nhưng thú thật chưa hiểu mấy & cố tình ứng dụng vô các công việc nhưng không xong; Sau đó bỏ lững,. . . . (Quả thật cũng có dị ứng với biến đối tượng do cảm giác chúng chiếm dụng nhiều tài nguyên đang lúc nào cũng hạn hẹp của mình,. . .)

Hôm nay thấy lại từ này, nên sẽ dành thêm thời gian rỗi ngâm cứu về nó & rất mong được sự trợ giúp từ cộng đồng.

Xin cảm ơn các bạn đã nêu vấn đề. Nhưng theo mình các bạn nào đang chập chững vô VBA thì chớ nhào vô những cái ni, nếu thời gian không thật sự rỗi rãnh.

Khà, khà,. . . .
 
Upvote 0
ngoài ra không dám chỉ bảo để bạn nói "mỉa mai" như trên.
Cảm ơn những góp ý của bạn... Nhưng mà, tôi nói thật lòng, bạn lại cho rằng tôi mỉa mai (biển học vô bờ, nào ai dám chê ai...)

ngoài ra còn có Collection Object, mà Collection thì khỏi dùng hàm CreateObject, chỉ việc khai báo biến thường lệ; sau đây tôi sẽ viết với Collection để chứng minh ta còn nhiều cách tiếp cận vấn đề. Đương nhiên không dám so hay hơn hàm UniqueRandomNum:

Mã:
Sub Test4()
    RandNum2 1, 30, 30
End Sub
Sub RandNum2(Btom As Long, Top As Long, Amount As Long)
    If Amount > Top - Bottom + 1 Then Amount = Top - Bottom + 1
    Randomize
    Dim UniNums As New Collection
    Do
        RNum = Int(Rnd() * (Top - Btom + 1)) + Btom
        On Error Resume Next
        UniNums.Add RNum, CStr(RNum)
    Loop Until UniNums.Count = Amount
    For i = 1 To Amount
    ActiveSheet.Cells(i, 1).Value = UniNums.Item(i)
    Next
 End Sub
Collection gần giống với Dictionary, nó được cái khỏi cần dùng CreateObject gì đó... nhưng nó cũng có cái dở, đó là:
- Không có Exists method để xác định sự tồn tại, cuối cùng thì bạn vẫn phải On Error Resume Next đấy thôi ---> rõ ràng bạn hiểu rất rõ lỗi có thể xãy ra nên mới dùng On Error... đúng không? ---> Vậy cũng có khác gì bài số #1?
- Gọi là Collection cũng đúng, nó chỉ làm nhiệm vụ "thu gom" vào 1 đóng lộn xộn (chẳng phải mảng) nên cuối cùng lại phải tốn thêm 1 vòng lập để duyệt qua các phần tử (Dictionary có Keys và Items đã là mảng rồi, cứ thế mà xài, khỏi thêm vòng lập)
----------------------------------------------------
Phân tích để thấy được hết sự ưu việt của Dictionary trong bài toán này ---> Tin chắc rằng dùng cách khác không thể tối ưu hơn được (chứ không phải nói là không thể dùng cách khác)
 
Lần chỉnh sửa cuối:
Upvote 0
Mình search thấy "New Collection" cũng gần giống "Scripting.Dictionary" nhưng chưa hiểu hết.
Các phần "item, key, before, after" dùng thế nào.
Nhờ NDU và Ba3ba3 cho 1 bài hướng dẫn cụ thể và có vd thì quá tốt. Mới mày mò được phần item và key.
Cám ơn nhiều.
 
Upvote 0
Mình search thấy "New Collection" cũng gần giống "Scripting.Dictionary" nhưng chưa hiểu hết.
Các phần "item, key, before, after" dùng thế nào.
Nhờ NDU và Ba3ba3 cho 1 bài hướng dẫn cụ thể và có vd thì quá tốt. Mới mày mò được phần item và key.
Cám ơn nhiều.
Đã biết cách dùng Dictionary rồi thì Collection là tương tự... Có điều nó chỉ có thế này:

untitled.JPG

"4 món ăn chơi" này xài y chang như Dictionary object thôi ThuNghi à
Còn "before, after" gì gì đó, mình chưa hiểu lắm
 
Upvote 0
Ah... tôi hiểu cái vụ After, before rồi
Nó giống như Add sheet ấy
Nói nhiều không bằng ví dụ
PHP:
Sub Test()
  Dim i As Long, Col As New Collection
  Col.Add "A", "1"
  For i = 2 To 10
   Col.Add Chr(64 + i), CStr(i), 1
  Next
  For i = 1 To 10
    MsgBox Col.Item(i)
  Next
End Sub
Hy vọng bạn hiểu
 
Upvote 0
Ah... tôi hiểu cái vụ After, before rồi
Nó giống như Add sheet ấy
Nói nhiều không bằng ví dụ
PHP:
Sub Test()
  Dim i As Long, Col As New Collection
  Col.Add "A", "1"
  For i = 2 To 10
   Col.Add Chr(64 + i), CStr(i), 1
  Next
  For i = 1 To 10
    MsgBox Col.Item(i)
  Next
End Sub
Hy vọng bạn hiểu
Mấu chốt là vậy. Cám ơn nhiều nhé.
Col.Add Chr(64 + i), CStr(i), 1
Hay
Col.Add Chr(64 + i), CStr(i), ,1
 
Upvote 0
Bạn thử xem hàm dùng Collection sau, đương nhiên sẽ chậm thua Function UniqueRandomNum, code nầy chỉ minh họa để các bạn thêm cách sử dụng Collection.
Ẹc... Ẹc...
Nếu bạn thích Collection như thế thì "tặng" bạn hàm tôi tự viết
PHP:
Function UniqueRandomNum(Bottom As Long, Top As Long, Amount As Long)
  Dim Arr(), i As Long, Tmp As Long, iCount As Long
  On Error Resume Next
  If Amount > Top - Bottom + 1 Then Amount = Top - Bottom + 1
  ReDim Arr(1 To Amount, 1 To 1)
  With New Collection
    Do
      iCount = .Count
      Tmp = Int(Rnd() * (Top - Bottom + 1)) + Bottom
      .Add Tmp, CStr(Tmp)
      If iCount <> .Count Then
        i = i + 1
        Arr(i, 1) = Tmp
      End If
    Loop Until .Count = Amount
    UniqueRandomNum = Arr
  End With
End Function
PHP:
Sub Test()
  Dim TG As Double
  TG = Timer
  Range("A1:A60000").Value = UniqueRandomNum(1, 100000, 60000)
  MsgBox Timer - TG
End Sub
Thuật toán như trên chắc bạn thừa hiểu: Hể Add được thằng nào thì quăng luôn thằng đó vào mảng (chẳng viêc gì phải thêm vòng lập nữa cho lòng vòng)
Hàm này tuy cũng chẳng hay ho gì nhưng được cái là:
- Chỉ dùng 1 vòng lập
- Tốc độ nhanh ít nhất gấp 100 lần code của bạn
- Code của tôi chạy 20000 dòng trong 0.2 giây, của bạn 51 giây
- Code của tôi chạy 60000 dòng trong 0.5 giây, của bạn thì... Ẹc... Ẹc... chẳng biết bao lâu mới xong, vì tôi chờ 5 phút và.. mất kiên nhân quá nên Ctrl + Break cho rồi (nếu không thì phải đi uống cafe để chờ)
----------------------------
Kết luận cuối cùng: Đã tối ưu hết mức. bằng cách dùng mảng, có thể tăng tốc độ code lên đến mức cực khủng... Nhưng dù sao vẫn phải dùng tí "mẹo" ---> khả năng uyển chuyển không thể như Dictionary được
Thật ra tôi biết Collection đã lâu nhưng từ khi biết được Dictionary thì tôi không còn thích dùng Collection nữa, vì nói chung là tôi chẳng thấy nó có gì hay cả (nếu không nói là... quá tệ)
Mời xem file nha
 

File đính kèm

  • Unique_RandomNum_2.xls
    22 KB · Đọc: 424
Lần chỉnh sửa cuối:
Upvote 0
bác ơi cho em hỏi, nếu em muốn tao ra một dãy số ngẫu nhiên đều hiện thị ở 4 chữ số thì làm sao hả bác
vd : nó hiện thị ra các số ở dạng là 0003,0023.....
bác cố giúp dùm em nha
thanks
 
Upvote 0
bác ơi cho em hỏi, nếu em muốn tao ra một dãy số ngẫu nhiên đều hiện thị ở 4 chữ số thì làm sao hả bác
vd : nó hiện thị ra các số ở dạng là 0003,0023.....
bác cố giúp dùm em nha
thanks
Thì bạn cứ tạo số bình thường, sau khi xong việc, bạn quét chọn vùng dữ liệu, vào menu Format\Cells ... Trong tab Number, bạn chọn Custom rồi gõ vào khung Type ở bên phải 4 số 0 (0000) ---> Vậy là xong!

untitled.JPG
 
Upvote 0
bác ơi cho em hỏi, nếu em muốn tao ra một dãy số ngẫu nhiên đều hiện thị ở 4 chữ số thì làm sao hả bác
vd : Nó hiện thị ra các số ở dạng là 0003,0023.....
Bác cố giúp dùm em nha
thanks
gõ số tự nhiên bình thường sau đó CHỌN VÙNG DỮ LIỆU VÀO FORMATCELL VÀ làm theo hình
 

File đính kèm

  • GPE.jpg
    GPE.jpg
    75.5 KB · Đọc: 484
Upvote 0
Web KT
Back
Top Bottom