Tạo dãy số ngẫu nhiên không trùng (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

anhtuan1066

Thành viên gạo cội
Tham gia
10/3/07
Bài viết
5,802
Được thích
6,912
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

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

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

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: 487
Upvote 0
hiện tại e đang làm 1 bài tập lọc số ngẫu nhiên nhưng phải thõa 2 điều kiện:
1>. trong dãy số phải có 000 (hoặc 999), ko nhất thiết phải liên tục (tức nằm ở bất kỳ vị trí nào) (vd: 04300, 40030, 99495, 99967...)
2>. trong dãy số có 2 số giống nhau nằm ở vị trí đầu (hoặc cuối) (vd: 55392, 44892, 32499, 85300...)
dãy số gồm 5 chữ số và cứ mỗi 100 số thì lấy ra 10 số phải thõa mãn đủ 2 điều kiện trên, lọc 10 lần để lấy ra 10 cụm với 10 con số sao cho số ở cụm này không trùng với số của cụm khác
e đang đau đầu với bài toán này, xin mấy pro tư vấn giải thuật cho e bik nhé!
 
Upvote 0
Lần sau nên lập topic riêng, xen ngang bị xóa hết là ráng chịu đó nghe!

hiện tại đang làm 1 bài tập lọc số ngẫu nhiên nhưng phải thõa 2 điều kiện:
1>. trong dãy số phải có 000 (hoặc 999), ko nhất thiết phải liên tục (tức nằm ở bất kỳ vị trí nào) (vd: 04300, 40030, 99495, 99967...)
2>. trong dãy số có 2 số giống nhau nằm ở vị trí đầu (hoặc cuối) (vd: 55392, 44892, 32499, 85300...)
dãy số gồm 5 chữ số và cứ mỗi 100 số thì lấy ra 10 số phải thõa mãn đủ 2 điều kiện trên, lọc 10 lần để lấy ra 10 cụm với 10 con số sao cho số ở cụm này không trùng với số của cụm khác

Tuy chưa hiểu hết í bạn, nhưng bạn tham khảo hàm tự tạo sau:
Mã:
Option Explicit
Function TimSo0(Num As Long)
 Dim jJ As Long, Max_ As Long
 Dim Giong As Boolean, Dm0 As Byte, Dm9 As Byte, VTr As Byte
 
 For jJ = 9 To 1 Step -1
   Max_ = Num \ 10 ^ jJ
   If Max_ > 0 Then
      VTr = VTr + 1
      If VTr = 1 And (Num \ 10 ^ (jJ - 1)) Mod 10 = Max_ Then Giong = True
      If Max_ Mod 10 = 0 Then
         Dm0 = Dm0 + 1
      End If
      If Max_ Mod 10 = 9 Then
         Dm9 = Dm9 + 1
      End If
   End If
 Next jJ
 If Giong And (Dm0 > 2 Or Dm9 > 2) Then
   TimSo0 = Num
 ElseIf Dm0 > 2 Or Dm9 > 2 Then
   If (Num \ 10 Mod 10) = Num Mod 10 Then TimSo0 = Num
 End If
End Function
 
Chỉnh sửa lần cuối bởi điều hành viên:
Upvote 0
hiện tại e đang làm 1 bài tập lọc số ngẫu nhiên nhưng phải thõa 2 điều kiện:
1>. trong dãy số phải có 000 (hoặc 999), ko nhất thiết phải liên tục (tức nằm ở bất kỳ vị trí nào) (vd: 04300, 40030, 99495, 99967...)
2>. trong dãy số có 2 số giống nhau nằm ở vị trí đầu (hoặc cuối) (vd: 55392, 44892, 32499, 85300...)
dãy số gồm 5 chữ số và cứ mỗi 100 số thì lấy ra 10 số phải thõa mãn đủ 2 điều kiện trên, lọc 10 lần để lấy ra 10 cụm với 10 con số sao cho số ở cụm này không trùng với số của cụm khác
e đang đau đầu với bài toán này, xin mấy pro tư vấn giải thuật cho e bik nhé!
Hình như đây là bài toán tìm kiếm và lọc... không thuộc chủ đề tạo số ngẫu nhiên thì phải
 
Upvote 0
Ẹ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

Do có việc cần nên lên mạng tìm thấy bài này hay quá.
Nhưng xin chủ nhân chỉ dùm nếu mình muốn chọn ngẫu nhiên trong dãy số có số thập phân thì phải chỉnh code ntn vậy (vd muốn lấy ngẩu nhiên 50 số trong khoảng 109.10 đến 110.20).
Xin chân thành cảm ơn.
 
Upvote 0
Do có việc cần nên lên mạng tìm thấy bài này hay quá.
Nhưng xin chủ nhân chỉ dùm nếu mình muốn chọn ngẫu nhiên trong dãy số có số thập phân thì phải chỉnh code ntn vậy (vd muốn lấy ngẩu nhiên 50 số trong khoảng 109.10 đến 110.20).
Xin chân thành cảm ơn.
Cũng dễ thôi ---> Lấy 50 số ngãu nhiên trong khoảng từ 10910 đến 11020, xong chia kết quả cho 100
Tức =UniqueRandomNum(10910,11020,50)/100
 
Upvote 0
toi cam on ban da dang code de tao so ngau nhien nay, nhung toi thac mac mot dieu la toi muon lam mot nut lenh ma khi bam vao nut lenh do thi so no chay tu dong va tu dung lai thi co duoc khong? neu duoc xin ban hay giúp minh voi, minh dang can
 
Upvote 0
xin chào! hiện giờ minh đang làm trò chơi xổ số bằng cách kích vào nút lệnh thì con số trong cell đó tự động chạy bất kì và tự dừng lại, sau khi dừng lại thì ta lấy kết quả cuối cùng( giống như tạo số ngẫu nhiên nhưng chỉ trong một cell và tự động chạy) thì làm bằng cách nào? xin có bạn nào làm đươc thì giúp mình với!!! bí quá< không làm được.
 
Upvote 0
Upvote 0
Ẹ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

Bác cho hỏi sao những lần chạy chương trình đều cho dãy số giống nhau thế ạ. Cụ thế là em mở file lần thứ 1 rồi cho chạy Macro lần 1, lần 2, lần 3...rồi đóng file lại. Mở lại file lần thứ 2 và cho chạy Macro lần 1, lần 2, lần 3...thì thấy kết quả [B]lần thứ 1[/B] của [I]lần mở file thứ 1[/I] giống [B]lần thứ 1[/B] của [I]lần mở file thứ 2[/I], [B]lần thứ 2[/B] của [I]lần mở file thứ 1[/I] giống [B]lần thứ 2[/B] của [I]lần mở file thứ 2, [/I][B]lần thứ 3[/B] của [I]lần mở file thứ 1[/I] giống [B]lần thứ 3[/B] của [I]lần mở file thứ 2... [/I]Gọn lại là [COLOR=#0000ff][B]kết quả lần chạy Macro thứ i[/B][/COLOR] của [COLOR=#ff0000][B][I]lần mở file thứ x[/I][/B][/COLOR] giống [COLOR=#0000ff][B]kết quả[/B] [B]lần chạy macro thứ i[/B][/COLOR] của [I][COLOR=#ff0000][B]lần mở file thứ y[/B][/COLOR]. Liệu Excel của em có bị bệnh không bác?

[/I]
 
Upvote 0
Ẹ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

Bác cho hỏi sao những lần chạy chương trình đều cho dãy số giống nhau thế ạ. Cụ thế là em mở file lần thứ 1 rồi cho chạy Macro lần 1, lần 2, lần 3...rồi đóng file lại. Mở lại file lần thứ 2 và cho chạy Macro lần 1, lần 2, lần 3...thì thấy kết quả [B]lần thứ 1[/B] của [I]lần mở file thứ 1[/I] giống [B]lần thứ 1[/B] của [I]lần mở file thứ 2[/I], [B]lần thứ 2[/B] của [I]lần mở file thứ 1[/I] giống [B]lần thứ 2[/B] của [I]lần mở file thứ 2, [/I][B]lần thứ 3[/B] của [I]lần mở file thứ 1[/I] giống [B]lần thứ 3[/B] của [I]lần mở file thứ 2... [/I]Gọn lại là [COLOR=#0000ff][B]kết quả lần chạy Macro thứ i[/B][/COLOR] của [COLOR=#ff0000][B][I]lần mở file thứ x[/I][/B][/COLOR] giống [COLOR=#0000ff][B]kết quả[/B] [B]lần chạy macro thứ i[/B][/COLOR] của [I][COLOR=#ff0000][B]lần mở file thứ y[/B][/COLOR]. Liệu Excel của em có bị bệnh không bác?

[/I][/QUOTE]
Do sơ sót thôi!
Sửa hàm UniqueRandomNum thành vầy:
[code]
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
    [COLOR=#ff0000][B]Randomize[/B][/COLOR]
    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[/code]
Thêm thằng em [COLOR=#ff0000][B]Randomize[/B][/COLOR] vào nữa, bảo đảm các lần chạy sẽ không bao giờ giống nhau
 
Upvote 0
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)
Em có ý kiến như thế này: sao bác không tạo cái name code của bác cho nó dễ nhớ đi ví dụ: UniqueRandomNum=CPE chẳng hạn :)) em góp ý kiến mong mọi người tham khảo, vì em có đổi cái tên đó thì vẫn đổi đc và sd bình thường
 
Upvote 0
Em có ý kiến như thế này: sao bác không tạo cái name code của bác cho nó dễ nhớ đi ví dụ: UniqueRandomNum=CPE chẳng hạn :)) em góp ý kiến mong mọi người tham khảo, vì em có đổi cái tên đó thì vẫn đổi đc và sd bình thường

Hàm này nhìn vào tên người ta hiểu mục đích của nó là để làm gì, vã lại đã là diễn đàn, ai cũng ghi ngắn gọn thì chắc chắn các hàm sẽ trùng tên nhau.

Nếu bạn muốn cá nhân hóa tên của nó, bạn cứ copy hàm đó về và sửa lại tên cho phù hợp với nhu cầu của bạn.

Thân.
 
Upvote 0
Cho em hỏi, nếu trong file GetUniqueRandNum.xls em chèn thêm 01 Sheet (gọi là Sheet_ketqua), trong đó khi thay đổi nội dung trong cell có địa chỉ A1 (chẳng hạn thì hàm bên phát sinh số ngẫu nhiên bên Sheet 1 sẽ tự động chạy mà không cẩn nhắp vào nút ở Sheet1).
Em xin cảm ơn.
 
Upvote 0
câu hỏi ngược lại. vậy có 20 số ngẫu nhiên vừa tạo ra. có thể tạo công thức liên quan từ 20 số trên không? ý là chỉ cần lấy 5 đến 10 số thôi (trong 20 số đó).
 
Upvote 0
câu hỏi ngược lại. vậy có 20 số ngẫu nhiên vừa tạo ra. có thể tạo công thức liên quan từ 20 số trên không? ý là chỉ cần lấy 5 đến 10 số thôi (trong 20 số đó).

Đã là ngẫu nhiên rồi còn liên quan cái gì nữa. Có mâu thuẫn không?

Theo Đại số học, nếu có liên quan thì cái liên quan duy nhất của chúng là chúng cùng là phần tử của một tập hợp.
 
Upvote 0
Đã là ngẫu nhiên rồi còn liên quan cái gì nữa. Có mâu thuẫn không?

Theo Đại số học, nếu có liên quan thì cái liên quan duy nhất của chúng là chúng cùng là phần tử của một tập hợp.

nếu 20 số đó từ máy tính cho trong 100 số trên, phần tử của tập hợp là 20 số. có liên quan nhau không?
nếu xảy ra 10 lần như trên, tìm tập hợp liên quan? (mỗi lần có 20 phần tử tập hợp, 10 lần có 10x20 số (sẽ có số trùng nhau). tìm xác suất liên quan?
 
Upvote 0
câu hỏi ngược lại. vậy có 20 số ngẫu nhiên vừa tạo ra. có thể tạo công thức liên quan từ 20 số trên không? ý là chỉ cần lấy 5 đến 10 số thôi (trong 20 số đó).

Thật ra cũng chưa hiểu bạn nói gì cả
Có thể cho 1 bảng tính cụ thể lên đây không?
 
Upvote 0
Upvote 0
nếu 20 số đó từ máy tính cho trong 100 số trên, phần tử của tập hợp là 20 số. có liên quan nhau không?
nếu xảy ra 10 lần như trên, tìm tập hợp liên quan? (mỗi lần có 20 phần tử tập hợp, 10 lần có 10x20 số (sẽ có số trùng nhau). tìm xác suất liên quan?

Bạn nên dùng hàm Draw (bác siwtom lập) tại , cho chuẩn hơn:
http://www.giaiphapexcel.com/forum/...thức-tính-một-dạng-Tổ-hợp&p=408551#post408551

còn việc
nếu xảy ra 10 lần như trên, tìm tập hợp liên quan? (mỗi lần có 20 phần tử tập hợp, 10 lần có 10x20 số (sẽ có số trùng nhau). tìm xác suất liên quan?

Bạn phải tự làm thui, vì có ai hiểu bạn nói gì đâu, vậy nhé
 
Upvote 0
cần giúp lọc ra ngẫu nhiên các dòng có tổng là một hàng số(ví dụ 20) và sắp xếp lên đầu
những dòng không thỏa mãn điều kiện có tổng là hằng số 20 thì đẩy xuống dưới cùng
cụ thể như file đính kèm
xin cảm ơn
 

File đính kèm

Upvote 0
Tình cờ vào đây đọc, thấy các anh tranh luận hay quá nhưng không biết đến bao giờ Thắng mới hiểu được những vấn đề mà các anh tranh luận, có vẻ như đang học lớp 1 mà lại xem kiến thức lớp 12 vậy.
 
Upvote 0
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)
Bác cho em hỏi chút,
Nếu bây giờ hàm của bác em không muốn dùng công thức mảng mà tạo số ngẫu nhiên trong khoảng đã cho và không trùng theo kiểu copy công thức từ ô A1 đến ô A30 thì như thế nào? Cảm ơn bác!
 
Upvote 0
Mình muốn tạo ra dãy số ngẫu nhiên không trùng nhau như này nhưng theo hàng ngang; mong mọi người giúp đỡ
 
Upvote 0
1. (Top - Bottom + 1) là 1 số ko thay đổi trong vòng lặp, để giảm tính toán nên đặt nó vào 1 biến tạm thời trước khi vào vào lặp.
2. "Scripting.Dictionary" là 1 COM, về giải thuật thì chắc chả có gì, nhưng nó đc viết trong C++, đã đc biên dịch ra mã máy tính rồi nên nó chạy nhanh lắm, dù các bác có giải thuật tốt trong vba thì về tốc độ chắc cũng ko lại đc với nó đâu.
 
Upvote 0
Tôi muốn ứng dụng cái
Function UniqueRandomNum
vô Word. Đã chép code vô word rồi.
Nhưng khi gặp
WorksheetFunction.Transpose
thì chương trình chịu. Vì tất nhiên nó là word nên không biết
WorksheetFunction
Có cách nào để vẫn dùng được hàm này trên Word??

Cảm ơn
 
Upvote 0
cái này mà thầy tuấn cải tiến thêm cho nó ngẫu nhiên vừa có số, vừa có chuỗi luôn thì hay quá
 
Upvote 0
tôi muốn ứng dụng cái
function uniquerandomnum
vô word. đã chép code vô word rồi.
Nhưng khi gặp
worksheetfunction.transpose
thì chương trình chịu. Vì tất nhiên nó là word nên không biết
worksheetfunction
có cách nào để vẫn dùng được hàm này trên word??

Cảm ơn
cái này thì phải insert excel vào trong word thì code chạy bình thường như trên excel thôi
tôi có ví dụ đây
 

File đính kèm

Upvote 0
Cảm ơn Lê Duy Thương.

Cái hay của file excel nhúng trong word với tôi lại là không cần xóa nội dung trong vùng được chép đến của filter Advance.

Sheet1.Range("A4:G81").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("E1:E2"), CopyToRange:=Range("A4:G4"), Unique:=False


Mọi nội dung ở dưới Range("A4:G4") (cho đến tận hàng cuối cùng) đều bị xóa, dù số hàng chép vô không nhiều.

Và tôi đã thử với file excel . Vẫn đúng. Kể cả chép kết quả vô cùng sheet có dữ liệu được lọc.

Có thể đây là thuộc tính của Excel. Có thể nó sẽ hữu ích cho mọi người
 
Upvote 0
cảm ơn lê duy thương.

Cái hay của file excel nhúng trong word với tôi lại là không cần xóa nội dung trong vùng được chép đến của filter advance.

Sheet1.range("a4:g81").advancedfilter action:=xlfiltercopy, _
criteriarange:=range("e1:e2"), copytorange:=range("a4:g4"), unique:=false


mọi nội dung ở dưới range("a4:g4") (cho đến tận hàng cuối cùng) đều bị xóa, dù số hàng chép vô không nhiều.

Và tôi đã thử với file excel . Vẫn đúng. Kể cả chép kết quả vô cùng sheet có dữ liệu được lọc.

Có thể đây là thuộc tính của excel. Có thể nó sẽ hữu ích cho mọi người
Cái CHIÊU insert excel vào word này tôi đã học được từ khi mới học tin học. Học lóm thôi. Lúc đó công thức và vba tôi mù tịt--=0--=0
 
Upvote 0
Bài 56 tôi có hỏi dùng hàm UniqueRandomNum trong word
Nội dung đã được sửa như sau (chữ đỏ in đậm và nghiêng là tôi sửa)
Function UniqueRandomNum(Bottom As Long, Top As Long, Amount As Long) As String
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 = Join(.Keys)

'Bỏ UniqueRandomNum = WorksheetFunction.Transpose(.Keys)
End With
End
Function

Do word cũng có 2 hàm Join và Split nên tôi chuyển array thành xâu
UniqueRandomNum = Join(.Keys)
Trong chương trình "mẹ" ta dùng lệnh gán
xx = Split(
UniqueRandomNum ) (xx phải là biến kiểu Variable). Sau đó dùng xx bình thường.

Nêu ra đây để thấy vấn đề đã giải quyết.

Tuy nhiên, tôi không thể nào gán trực tiếp vô biến để không cần vòng vo như trên (dù rằng không dài dòng lắm). Mong sự góp ý của các bạn.
 
Lần chỉnh sửa cuối:
Upvote 0
Bài 56 tôi có hỏi dùng hàm UniqueRandomNum trong word
Nội dung đã được sửa như sau (chữ đỏ in đậm và nghiêng là tôi sửa)
Function UniqueRandomNum(Bottom As Long, Top As Long, Amount As Long) As String
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 = Join(.Keys)

'Bỏ UniqueRandomNum = WorksheetFunction.Transpose(.Keys)
End With
End
Function

Do word cũng có 2 hàm Join và Split nên tôi chuyển array thành xâu
UniqueRandomNum = Join(.Keys)
Trong chương trình "mẹ" ta dùng lệnh gán
xx = Split(
UniqueRandomNum ) (xx phải là biến kiểu Variable). Sau đó dùng xx bình thường.

Nêu ra đây để thấy vấn đề đã giải quyết.

Tuy nhiên, tôi không thể nào gán trực tiếp vô biến để không cần vòng vo như trên (dù rằng không dài dòng lắm). Mong sự góp ý của các bạn.

ở đây chưa nói đến chuyện giải thuật chọn Random (giải thuật dùng On error kết hợp .Add là quá dở )
Có những cái khó hiểu mà chắc tại tôi chưa biết gì về Word nên thấy khó hiểu ?
hàm .Keys của Dic đã trả về 1 mảng 1 chiều rồi , tại sao phải

Mã:
[B][I]UniqueRandomNum = Join(.Keys)[/I][/B]
rồi ở dưới lại
Mã:
[COLOR=#000000][COLOR=#000000]xx = Split([/COLOR][/COLOR][B][I]UniqueRandomNum[/I][COLOR=#000000] )[/COLOR][/B]

tại sao không là
Mã:
[B][I]UniqueRandomNum = .Keys[/I][/B]
ở dưới
Mã:
[COLOR=#000000][COLOR=#000000]xx =[/COLOR][/COLOR][B][I]UniqueRandomNum[/I][/B]

xin cho biết lý do ?
 
Upvote 0

...
UniqueRandomNum = Join(.Keys)


<1> 'Bỏ UniqueRandomNum = WorksheetFunction.Transpose(.Keys)
End With
End
Function

<2> Do word cũng có 2 hàm Join và Split nên tôi chuyển array thành xâu
UniqueRandomNum = Join(.Keys)
Trong chương trình "mẹ" ta dùng lệnh gán
<3> xx = Split(UniqueRandomNum ) (xx phải là biến kiểu Variable). Sau đó dùng xx bình thường.

Nêu ra đây để thấy vấn đề đã giải quyết.

<4> Tuy nhiên, tôi không thể nào gán trực tiếp vô biến để không cần vòng vo như trên (dù rằng không dài dòng lắm). Mong sự góp ý của các bạn.

Chi tiết:
<1> Worksheetfunction là một object của Excel. Đương nhiên nếu file Word khong có nói vào Excel thì khong thể gọi object này.

<2> Hàm Join và Split là hàm của VBA nói chung. Khong phải của Word, Excel, hay Access gì cả

<3> Trong từ ngữ lập trình, variable có nghĩa là biến. Variance mới là kiểu biến động.

<4> gán trực tiếp vô biến có nghĩa là sao? Nếu muón hàm trả về môt mảng thì cứ việc cho nó là As Variant
 
Upvote 0
Chi tiết:
<1> Worksheetfunction là một object của Excel. Đương nhiên nếu file Word khong có nói vào Excel thì khong thể gọi object này.

<2> Hàm Join và Split là hàm của VBA nói chung. Khong phải của Word, Excel, hay Access gì cả

<3> Trong từ ngữ lập trình, variable có nghĩa là biến. Variance mới là kiểu biến động.

<4> gán trực tiếp vô biến có nghĩa là sao? Nếu muón hàm trả về môt mảng thì cứ việc cho nó là As Variant

Chính xác phải là

<2> Hàm Join và Split là hàm của VBA nói chung tức là của Word, Excel, hay Access.
<3> Variant mới là kiểu biến động. Như ví dụ sau (đã chạy thử), biến a có thể nhận mọi kiểu dữ liệu

Option Explicit
Sub vidu()
Dim a As Variant
a = "dfgh"
a = 1
a = Array(1, 3, 5)
End Sub

Do biến kiểu này thường bỏ qua phần "As Variant" nên nhiều khi kg cần nhớ chính xác

<4> Tôi đang thử gán trực tiếp. Nếu được sẽ comment sau

Cảm ơn VetMini
 
Lần chỉnh sửa cuối:
Upvote 0
Sẵn góp ý trong thớt này. Tôi có một vài điều nói thêm cho hàm này. Lưu ý trước là tôi không hề nhận xét vấn đề thuật toán nhanh chậm hay tốt xấu, xin đừng hiểu lầm sinh ra tranh cãi vô ích. Mục đích tôi là bổ sung phần phạm vi (giới hạn) và phương pháp sử dụng.

1. Thứ nhất, hàm này dùng kỹ thuật lặp lại nếu bị trùng số. Vì vậy, nếu khoảng tính lớn (cỡ 100000) và số lượng cần lấy ra rất gần với khoảng tính (cỡ 99000) thì càng về sau số trùng càng gặp nhiều, tốc đọ sẽ bị giảm. Trong trường hợp thật tệ, có thể hàm chạy hoài không dứt.

Như vậy, cần lưu ý khi dùng hàm này rằng số cần lấy không được gần sát với khảng tính. Lưu ý lần nữa: toi không nói hàm sai, không dùng được. Ở đây chỉ bàn phạm vi sử dụng thôi.

2. Thứ hai, Hàm nguyên thuỷ được viết theo kiểu số ngẫu nhiên giả tạo. Tức là mỗi lần chạy thì cho ra loạt sô in hệt nhau. Ở khoảng bài #37, tác giả có thêm lệnh ramdomize vào hàm để dùng trong trường hợp ngẫu nhiên thật (mỗi lần chạy cho ra loạt số khác nhau)

Bình thường, ta có thể dùng lệnh chỉ dẫn trình dịch (compiler dirrectives) để làm việc này. Điển hình là lệnh #If

Ở đầu module chứa hàm, đặt code này
#Const NGAUNHIENTHAT = True
' sửa thành False khi cần chạy code random giả

Bên trong hàm, đặt lệnh này ở dòng đầu tiên
#If NGAUNHIENTHAT Then
Randomize
#End If

(random giả có nghĩa là một loạt số ngẫu nhiên được tạo sẵn trong máy. Mỗi lượt chạy, loạt số này được lôi ra dùng, cho nên chúng in hệt nhau. Đôi khi vì lý do thí nghiệm thống kê người ta phải dùng random giả)

3. Thứ ba, hàm này để yên như vậy thì gọn và đơn giản. Nhưng nếu thêm mọt chút thì cách sử dụng có thể đơn giản hơn.

Sửa dòng cuối của hàm UniqueRandomNum, cho nó trả về nguyên mảng/collection .keys
(sau khi sửa, hàm này không còn gọi Application.Transpose, và không phải lệ thuộc vào Excel nữa, và có thể dùng cho Word, Access)

Thêm vào cùng module một hàm UnqRnd(Bottom, Top)
Bên trong hàm này, đặt code giám sát vùng được chọn và gọi hàm UniqueRndomNum
Nếu vùng được chọn là dọc thì trả lại:
Application.Transpose(UniqueRandomNum(bottom, top, amount))
Nếu vùng được chọn là ngang thì trả lại:
Application.Transpose(Application.Transpose(UniqueRandomNum(bottom, top, amount)))

Đại khái:
Public Function UnqRnd(Bottom As Long, Top As Long)
UnqRnd = UniqueRandomNum(Bottom, Top, Application.Caller.Cells.Count)
if Application.Caller.Rows.Count > 1 Then UnqRnd = Application.Transpose(UnqRnd)
End Function

Sử dụng hàm này chỉ cần bôi đen vùng chọn, gõ công thức với chận dưới, chận trên và Ctrl+Shift+Enter. Hàm sẽ tự động tính số dữ liệu cần lấy. Hàm cũng tự động biết trải ngang hay dọc tuỳ theo vùng chọn.


@haonlh: đúng rồi, ở bai #63, tôi gõ nhầm Variant (mọt từ khoá của VBA) thành Variance (một đối tượng trong toán thống kê)
 
Lần chỉnh sửa cuối:
Upvote 0
Tôi cảm ơn VetMini có nói đến bài 37 của ndu. Tôi đọc lại bài này thì không thấy dùng WorksheetFunction.Transpose nữa. Vì bài 56 tôi hỏi là
Tôi muốn ứng dụng cái
Function UniqueRandomNum
vô Word. Đã chép code vô word rồi.
Nhưng khi gặp
WorksheetFunction.Transpose
thì chương trình chịu. Vì tất nhiên nó là word nên không biết
WorksheetFunction
Có cách nào để vẫn dùng được hàm này trên Word??
(tôi chép code của bài 1 của anhtuan1066)

Thật là tuyệt vời vì code bài 37 áp dụng ngay vô trong word được rồi. Chỉ cần chú ý là UniqueRandomNum cho mảng 2 chiều vì có lệnh (xem lại bài 37)
ReDim Arr(1 To Amount, 1 To 1).

Chắc có thể biến hàm này thành Sub nếu biến Arr được khai báo trước mọi sub và function.

Cũng cảm ơn thêm vì biết thêm khái niệm

"lệnh chỉ dẫn trình dịch (compiler dirrectives) để làm việc này. Điển hình là lệnh #If"

Nhiều khi đọc code của ai đó thấy nó mà kg hiểu gì. Cũng kg hiểu gì mục đánh số 3 của bài 65 của bạn. Tức là sẽ hiểu sau, hy vọng thế.

Chúc VetMini khỏe :)

 
Upvote 0
Chào cả nhà,

Mình muốn chia số tự động. Ví dụ mình có 1 dãy số từ 1 đến 10.

Mình muốn thành 3 dãy số ngẫu nhiên (3 số, 2 số và 5 số), đặc biệt số đã xuất hiện rồi thì không được xuất hiện nữa, chia đến khi hết số thì thôi.
Ví dụ:
- Dãy A: 1, 3
- Dãy B: 2, 4, 9
- Dãy C: 5, 7, 6, 8, 10

Vậy mình phải dùng công thức Random như thế nào ạ?

Mong được cả nhà góp ý.
 
Upvote 0
Mình muốn chia số tự động. Ví dụ mình có 1 dãy số từ 1 đến 10.

Mình muốn thành 3 dãy số ngẫu nhiên (3 số, 2 số và 5 số), đặc biệt số đã xuất hiện rồi thì không được xuất hiện nữa, chia đến khi hết số thì thôi.
Ví dụ: . . . .
Vậy mình phải dùng công thức Random như thế nào ạ?

B1: Khai báo 1 biến kiểu chuỗi;
B2: Thiết lập vòng lặp nhét tất các số vô biến chuỗi
B2.1: Xáo trộn tùy í trong chuỗi bằng vòng lặp;
B3: Cắt khúc theo í bạn
 
Upvote 0
B1: Khai báo 1 biến kiểu chuỗi;
B2: Thiết lập vòng lặp nhét tất các số vô biến chuỗi
B2.1: Xáo trộn tùy í trong chuỗi bằng vòng lặp;
B3: Cắt khúc theo í bạn

hi mình chỉ biết sơ sơ macro thôi nên đọc thì hiểu ý bạn nói nhưng để viết được thì phải nhờ bạn hỗ trợ giúp mình với.

Cảm ơn bạn.
 
Upvote 0
PHP:
Option Explicit
Sub Tao3NhomNgau()
 Dim Num As Integer, J As Long
 Dim StrC As String
1 'Tao Chuoi:'
 For J = 1 To 10
    If J Mod 2 = 1 Then
        StrC = StrC & Right("0" & CStr(J), 2)
    Else
        StrC = Right("0" & CStr(J), 2) & StrC
    End If
 Next J
2 'Tron Chuoi:'
 Randomize
 For J = 1 To 999
    Num = 2 * (1 + 3 * Rnd \ 1)
    StrC = Mid(StrC, Num + 1, 20) & Left(StrC, Num)
 Next J
3 'Cát Chuoi:'
 MsgBox Left(StrC, 4) & "; " & Mid(StrC, 5, 6) & "; " & Mid(StrC, 11, 4)
End Sub
 
Upvote 0
Hi,

Mình xin nêu rõ vấn đề mình đang gặp như sau. Mình có 1 danh sách khách hàng sẽ tổ chức quay số bằng lồng cầu, mỗi khách có số lượng Tem khác nhau. Nhưng tổng banh để quay thì nhỏ hơn rất nhiều so với tổng Tem, nên sẽ có trường hợp 1 số lặp lại nhiều lần. Vậy làm cách nào để chia số tự động nhanh nhất theo danh sách miễn sao mỗi khách không có số nào bị lặp lại và các số phải trải dài ngẫu nhiên theo số banh không theo thứ tự.

Mình có gửi kèm file. Mong được cả nhà trợ giúp.

Cảm ơn rất nhiều,
 

File đính kèm

Upvote 0
Hi,

Mình xin nêu rõ vấn đề mình đang gặp như sau. Mình có 1 danh sách khách hàng sẽ tổ chức quay số bằng lồng cầu, mỗi khách có số lượng Tem khác nhau. Nhưng tổng banh để quay thì nhỏ hơn rất nhiều so với tổng Tem, nên sẽ có trường hợp 1 số lặp lại nhiều lần. Vậy làm cách nào để chia số tự động nhanh nhất theo danh sách miễn sao mỗi khách không có số nào bị lặp lại và các số phải trải dài ngẫu nhiên theo số banh không theo thứ tự.

Mình có gửi kèm file. Mong được cả nhà trợ giúp.

Cảm ơn rất nhiều,

theo như trong file thì không có cách gì làm được bạn ạ
Vì Nguyễn Văn 1 có 52 tem , trong khi chỉ có 50 banh , vậy bạn cho biết 2 tem còn dư của Nguyễn Văn 1 ta sẽ điền số mấy ?
Muốn làm được ít nhất bạn phải bảo đảm được : số lượng banh của bạn ít nhất cũng phải đủ cho số tem của 1 khách hàng trước đã
 
Lần chỉnh sửa cuối:
Upvote 0
Mình xin lỗi vì mình đã có sai sót rồi. Tối đa là số 50 số (mình gửi lại file kèm). Và đảm bảo số Tem của mỗi khách sẽ không bao giờ vượt quá tổng số banh.

Cảm ơn bạn.
 

File đính kèm

Upvote 0
Mình xin lỗi vì mình đã có sai sót rồi. Tối đa là số 50 số (mình gửi lại file kèm). Và đảm bảo số Tem của mỗi khách sẽ không bao giờ vượt quá tổng số banh.

Cảm ơn bạn.

thử bấm nút trong file đính kèm , theo tôi thì nên ghi kết quả ra sheet khác , vì mỗi người bạn đâu biết trước có mấy tem đâu mà chừa dòng , nếu bạn vẫn muốn ghi kết quả luôn vào sheet "SO TEM" thì báo lại nhé
 

File đính kèm

Upvote 0
thử bấm nút trong file đính kèm , theo tôi thì nên ghi kết quả ra sheet khác , vì mỗi người bạn đâu biết trước có mấy tem đâu mà chừa dòng , nếu bạn vẫn muốn ghi kết quả luôn vào sheet "SO TEM" thì báo lại nhé

Quá tuyệt vời. Cảm ơn bạn rất nhiều
 
Upvote 0
thử bấm nút trong file đính kèm , theo tôi thì nên ghi kết quả ra sheet khác , vì mỗi người bạn đâu biết trước có mấy tem đâu mà chừa dòng , nếu bạn vẫn muốn ghi kết quả luôn vào sheet "SO TEM" thì báo lại nhé

Nhưng bạn ơi số lần lặp lại của các số banh theo file của bạn không giống nhau rồi. Làm sao để mỗi số có số lần lặp lại giống nhau. VD: 300 tem mà 50 số thì từ số 1 đến số 50 mỗi số sẽ lặp lại 6 lần. Số banh bắt đầu luôn là số 1 trải dài theo thứ tự tới số banh cao nhất phải được lặp lại giống nhau.
 
Lần chỉnh sửa cuối:
Upvote 0
Nhưng bạn ơi số lần lặp lại của các số banh theo file của bạn không giống nhau rồi. Làm sao để mỗi số có số lần lặp lại giống nhau. VD: 300 tem mà 50 số thì từ số 1 đến số 50 mỗi số sẽ lặp lại 6 lần. Số banh bắt đầu luôn là số 1 trải dài theo thứ tự tới số banh cao nhất phải được lặp lại giống nhau.

cứ từ rồi cũng xong chứ làm gì nhắn tin gửi thư ghê vậy ?
Bạn kiểm tra file này
 

File đính kèm

Upvote 0
hi doveandrose,

Xin lỗi vì đã làm phiền bạn. Nhưng thật sự mình rất cần sự trợ giúp. Mình rất ngại nhưng không biết phải làm sao.

Nói về form chia tem ngẫu nhiên hôm trước, nếu mình cần giới hạn thêm điều kiện ưu tiên của Khu Vực và Cửa hàng nữa thì có được không bạn?

Ưu tiên phân bổ các số banh từ 1...số lớn nhất phải có ở Khu vực hoặc Cấp 1 ít nhất 1 lần. Khi nào đã chia hết các số banh mà còn tem thì mới cho lặp lại.

(Mình gửi kèm theo file minh họa)

Rất cảm ơn vì được hỗ trợ.
 

File đính kèm

Upvote 0
Nói về form chia tem ngẫu nhiên hôm trước, nếu mình cần giới hạn thêm điều kiện ưu tiên của Khu Vực và Cửa hàng nữa thì có được không bạn?

Ưu tiên phân bổ các số banh từ 1...số lớn nhất phải có ở Khu vực hoặc Cấp 1 ít nhất 1 lần. Khi nào đã chia hết các số banh mà còn tem thì mới cho lặp lại.

(Mình gửi kèm theo file minh họa)

file minh họa bạn gửi lên ngoài việc có thêm 2 sheet ra thì không chú thích gì thêm thì sao tôi hiểu được , mấy con số trong các sheet kiểm tra tem phải thỏa mãn điều kiện gì ? và thật ra file có bao nhiêu sheet ? để làm luôn 1 lần , chứ chơi kiểu mỗi ngày đẻ ra thêm 2 sheet mới là tôi nghỉ luôn đó .
 
Upvote 0
file minh họa bạn gửi lên ngoài việc có thêm 2 sheet ra thì không chú thích gì thêm thì sao tôi hiểu được , mấy con số trong các sheet kiểm tra tem phải thỏa mãn điều kiện gì ? và thật ra file có bao nhiêu sheet ? để làm luôn 1 lần , chứ chơi kiểu mỗi ngày đẻ ra thêm 2 sheet mới là tôi nghỉ luôn đó .

Em kết cái chỗ bôi màu đỏ...
Xin lỗi bác "Chim Hồng" nhé.
Tại em mắc cười quá nên vào spam tẹo --=0--=0
 
Upvote 0
file minh họa bạn gửi lên ngoài việc có thêm 2 sheet ra thì không chú thích gì thêm thì sao tôi hiểu được , mấy con số trong các sheet kiểm tra tem phải thỏa mãn điều kiện gì ? và thật ra file có bao nhiêu sheet ? để làm luôn 1 lần , chứ chơi kiểu mỗi ngày đẻ ra thêm 2 sheet mới là tôi nghỉ luôn đó .

hi,

2 sheet mình mới thêm vào là do mình tổng hợp lại từ sheet1 để kiểm tra số banh đã chia có thỏa điều kiện không thôi, không có yêu cầu đẻ ra sheet mới đâu nà.

Điều kiện mình cần kiểm tra của 2 sheet "Kiem tra tem...." là: nếu có ô nào còn trống thì không có số nào của cột đó >1 mình đang đếm số lần xuất hiện, các số ít nhất phải xuất hiện 1 lần trước khi có số khác lặp lại.

VD: ở sheet Kiem tra tem (KV) cột Khu vực 3 còn nhiều số chưa xuất hiện 5, 7, 11, 14....nhưng lại có nhiều số được lặp lại 2 lần 12, 37, 35, ....

Mình diễn đạt hơi kém nên không biết cả nhà có hiểu ý không nữa.

Rất cảm ơn cả nhà đã hỗ trợ.
 
Upvote 0
Không biết có giải pháp nào thỏa điều kiện như trên không bạn doveandrose ?
 
Upvote 0
Không biết có giải pháp nào thỏa điều kiện như trên không bạn doveandrose ?

giải pháp thì có , nhưng hôm qua tôi đã nhắc nhở 1 lần , cứ từ từ thì cái gì cũng xong , thế mà hôm nay vẫn tiếp tục tái diễn trò spam hối nhau , đã vậy tôi cho chủ đề này trôi luôn . Từ bây giờ đến thứ 2 tuần sau , nếu không ai làm giúp bạn thì tôi mới up file lên nhé , để bạn biết spam hối thúc tôi thì sẽ thế nào .
 
Upvote 0
hi,

2 sheet mình mới thêm vào là do mình tổng hợp lại từ sheet1 để kiểm tra số banh đã chia có thỏa điều kiện không thôi, không có yêu cầu đẻ ra sheet mới đâu nà.

Điều kiện mình cần kiểm tra của 2 sheet "Kiem tra tem...." là: nếu có ô nào còn trống thì không có số nào của cột đó >1 mình đang đếm số lần xuất hiện, các số ít nhất phải xuất hiện 1 lần trước khi có số khác lặp lại.

VD: ở sheet Kiem tra tem (KV) cột Khu vực 3 còn nhiều số chưa xuất hiện 5, 7, 11, 14....nhưng lại có nhiều số được lặp lại 2 lần 12, 37, 35, ....

Mình diễn đạt hơi kém nên không biết cả nhà có hiểu ý không nữa.

Rất cảm ơn cả nhà đã hỗ trợ.
Mình chỉ bạn nè, bạn réo tên Thầy Ba Tê á, có bài giải liền hà
Còn không được nữa thì ....ráng chờ. Híc
Thân
 
Upvote 0
làm thử bạn kiểm tra lại, để tiện cho bạn kiểm tra mình làm thêm sheet2
 

File đính kèm

Upvote 0
giải pháp thì có , nhưng hôm qua tôi đã nhắc nhở 1 lần , cứ từ từ thì cái gì cũng xong , thế mà hôm nay vẫn tiếp tục tái diễn trò spam hối nhau , đã vậy tôi cho chủ đề này trôi luôn . Từ bây giờ đến thứ 2 tuần sau , nếu không ai làm giúp bạn thì tôi mới up file lên nhé , để bạn biết spam hối thúc tôi thì sẽ thế nào .

Mình vẫn đang mong chờ giải pháp của bạn. Nếu có thể hy vọng được bạn hỗ trợ.
 
Upvote 0
ủa tôi tưởng bạn tải file #85 xài rồi chứ , không thấy khiếu nại gì thì tôi cứ yên tâm là file #85 sử dụng được . Bạn đã sử dụng file #85 chưa ?

Mình cũng có sử dụng nhưng vẫn không như ý của mình mong muốn. Cảm ơn bạn HieuCD đã hỗ trợ.
 
Upvote 0
Mình cũng có sử dụng nhưng vẫn không như ý của mình mong muốn


à có khiếu nại thì ta tính tiếp . Bạn cho biết 1 cửa hàng nằm trên nhiều khu vực có thật không ? tôi thấy có vẻ vô lý . Bạn giải thích dùm tôi khúc này

cbb29e2b1b31a9fdbcd46c5bc274e306.png
 
Upvote 0
à có khiếu nại thì ta tính tiếp . Bạn cho biết 1 cửa hàng nằm trên nhiều khu vực có thật không ? tôi thấy có vẻ vô lý . Bạn giải thích dùm tôi khúc này

cbb29e2b1b31a9fdbcd46c5bc274e306.png


Khu vực ở đây chỉ là vị trí ngồi thôi bạn, không phải khu vực địa lý. Cửa hàng có nhiều khách thì ngồi ở nhiều khu vực ạ.
 
Upvote 0
Khu vực ở đây chỉ là vị trí ngồi thôi bạn, không phải khu vực địa lý. Cửa hàng có nhiều khách thì ngồi ở nhiều khu vực ạ.

Nếu 1 khu vực chứa nhiều cửa hàng và 1 cửa hàng cũng nằm trên nhiều khu vực thì đây là bài toán thật sự khó , hoặc có thể là tôi chưa nhìn ra chìa khóa giúp đơn giản hóa vấn đề . Bạn thử chạy file này xem sao
 

File đính kèm

Upvote 0
Cảm ơn bạn nhiều lắm. Vậy là đã hợp lý rồi ạ
 
Upvote 0
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)

Code trên có một điểm yếu mà rất dễ gây treo máy Until .Count = Amount


Nếu Amount=99% * Top và top tương đối lớn thì nó chạy rất là chậm và không ổn định về mặt thời gian. Giả sử top=1000, và amount=999, hàm tìm được 998 giá trị. Khi tìm giá trị cuối cùng thì xác xuất thành công sẽ là (1000-998)/1000, khá nhỏ, nên dễ gây treo máy. Thử nghiệm top=500000 và amount=495000 có khi chạy mất 20s tới 40s.
Với code dưới, nó chạy cực nhanh luôn mà không cần dùng dic hoặc collect.
Mã:
Function UniqueRandomNum2(Bottom As Long, Top As Long, Amount As Long)

    If Top - Bottom + 1 < Amount Or Amount <= 0 Then
        UniqueRandomNum2 = CVErr(xlErrNA)
        Exit Function
    End If
    
    Dim lTemp As Long
    Dim lNum As Long
    Dim lIndex As Long
    Dim lStart As Long
    
    Dim Ar() As Long
    Dim arKq() As Long
    
    lNum = Top - Bottom + 1
    ReDim Ar(1 To lNum) As Long
    ReDim arKq(1 To Amount, 1 To 1) As Long
    
    lStart = Bottom - 1
    For lTemp = 1 To Amount
        Do
            lIndex = 1 + Int(Rnd() * lNum)
        Loop While lNum < lIndex
        
        If Ar(lIndex) = 0 Then
            arKq(lTemp, 1) = lIndex + lStart
        Else
            arKq(lTemp, 1) = Ar(lIndex) + lStart
        End If
        
        If Ar(lNum) = 0 Then
            Ar(lIndex) = lNum
        Else
            Ar(lIndex) = Ar(lNum)
        End If
        lNum = lNum - 1
        
    Next
    
    
      
    
    UniqueRandomNum2 = arKq
 
 
End Function
 

File đính kèm

Upvote 0
Code trên có một điểm yếu mà rất dễ gây treo máy Until .Count = Amount


Nếu Amount=99% * Top và top tương đối lớn thì nó chạy rất là chậm và không ổn định về mặt thời gian. Giả sử top=1000, và amount=999, hàm tìm được 998 giá trị. Khi tìm giá trị cuối cùng thì xác xuất thành công sẽ là (1000-998)/1000, khá nhỏ, nên dễ gây treo máy. Thử nghiệm top=500000 và amount=495000 có khi chạy mất 20s tới 40s.
Với code dưới, nó chạy cực nhanh luôn mà không cần dùng dic hoặc collect.
Mã:
Function UniqueRandomNum2(Bottom As Long, Top As Long, Amount As Long)

    If Top - Bottom + 1 < Amount Or Amount <= 0 Then
        UniqueRandomNum2 = CVErr(xlErrNA)
        Exit Function
    End If
 
    Dim lTemp As Long
    Dim lNum As Long
    Dim lIndex As Long
    Dim lStart As Long
 
    Dim Ar() As Long
    Dim arKq() As Long
 
    lNum = Top - Bottom + 1
    ReDim Ar(1 To lNum) As Long
    ReDim arKq(1 To Amount, 1 To 1) As Long
 
    lStart = Bottom - 1
    For lTemp = 1 To Amount
        Do
            lIndex = 1 + Int(Rnd() * lNum)
        Loop While lNum < lIndex
     
        If Ar(lIndex) = 0 Then
            arKq(lTemp, 1) = lIndex + lStart
        Else
            arKq(lTemp, 1) = Ar(lIndex) + lStart
        End If
     
        If Ar(lNum) = 0 Then
            Ar(lIndex) = lNum
        Else
            Ar(lIndex) = Ar(lNum)
        End If
        lNum = lNum - 1
     
    Next
 
 
   
 
    UniqueRandomNum2 = arKq
 
 
End Function

chào mừng bạn đến châu Mỹ. Nhưng thật tiếc tác giả đề tài này đã cải tiến code rồi. Người ta dùng có 1 vòng lặp thôi bạn ạ.
 
Upvote 0
chào mừng bạn đến châu Mỹ. Nhưng thật tiếc tác giả đề tài này đã cải tiến code rồi. Người ta dùng có 1 vòng lặp thôi bạn ạ.

Dùng bao nhiêu vòng lặp mình nghĩ không quan trọng, thuật toán mới là thứ để nói, vòng lặp Do của mình viết ra cho nó có, chứ hầu như mỗi lần nó chỉ thực hiện duy nhất một lần thôi nhé. Mình cho nó vào để đề phòng những trường hợp do sai số tính toán mà có thể gây lôi.

Mình thì chưa biết code mới như thế nào, nhưng nếu dùng dic thì chưa chắc nhanh đâu nhé, bởi code trên đều thao tác trên mảng.
 
Upvote 0
Dùng bao nhiêu vòng lặp mình nghĩ không quan trọng, thuật toán mới là thứ để nói, vòng lặp Do của mình viết ra cho nó có, chứ hầu như mỗi lần nó chỉ thực hiện duy nhất một lần thôi nhé. Mình cho nó vào để đề phòng những trường hợp do sai số tính toán mà có thể gây lôi.

Mình thì chưa biết code mới như thế nào, nhưng nếu dùng dic thì chưa chắc nhanh đâu nhé, bởi code trên đều thao tác trên mảng.
Đề tài này cũng lâu lắm rồi bạn à (năm 2009) và sau đó đã được cải tiến rất nhiều
Mã:
Function UniqueRandNum(ByVal Bottom As Long, ByVal Top As Long, ByVal Amount As Long)
  Dim i As Long, lPos As Long, n As Long, lTmp As Long, idx As Long
  'Application.Volatile '<--- Neu muon gia tri thay doi khi bam F9
  If Top > Bottom Then
    If Amount > Top - Bottom + 1 Then Amount = Top - Bottom + 1
    ReDim arr(Bottom To Top) As Long
    ReDim aDes(1 To Amount, 1 To 1)
    n = Top - Bottom + 1
    For i = 1 To Amount
      idx = n + Bottom - 1
      lPos = Int(Rnd() * n) + Bottom
      If arr(lPos) = 0 Then arr(lPos) = lPos
      If arr(idx) = 0 Then arr(idx) = idx
      aDes(i, 1) = arr(lPos)
      lTmp = arr(lPos): arr(lPos) = arr(idx): arr(idx) = lTmp
      n = n - 1
    Next
    UniqueRandNum = aDes
   End If
End Function
 
Upvote 0
Đề tài này cũng lâu lắm rồi bạn à (năm 2009) và sau đó đã được cải tiến rất nhiều
Mã:
Function UniqueRandNum(ByVal Bottom As Long, ByVal Top As Long, ByVal Amount As Long)
  Dim i As Long, lPos As Long, n As Long, lTmp As Long, idx As Long
  'Application.Volatile '<--- Neu muon gia tri thay doi khi bam F9
  If Top > Bottom Then
    If Amount > Top - Bottom + 1 Then Amount = Top - Bottom + 1
    ReDim arr(Bottom To Top) As Long
    ReDim aDes(1 To Amount, 1 To 1)
    n = Top - Bottom + 1
    For i = 1 To Amount
      idx = n + Bottom - 1
      lPos = Int(Rnd() * n) + Bottom
      If arr(lPos) = 0 Then arr(lPos) = lPos
      If arr(idx) = 0 Then arr(idx) = idx
      aDes(i, 1) = arr(lPos)
      lTmp = arr(lPos): arr(lPos) = arr(idx): arr(idx) = lTmp
      n = n - 1
    Next
    UniqueRandNum = aDes
   End If
End Function
Dựa trên code của bạn, bỏ vài lệnh
Mã:
Function UniqueRandom(ByVal Bottom As Long, ByVal Top As Long, ByVal N As Long) As Variant
  Dim Arr() As Long, Darr() As Long, Tmp As Long, i As Long, k As Long, ik As Long
  If Top > Bottom Then
    If N > Top - Bottom + 1 Then N = Top - Bottom + 1
    ReDim Darr(Bottom To Top):      ReDim Arr(1 To N, 1 To 1)
    Randomize
    k = Top - Bottom + 1
    For i = 1 To N
      ik = k + Bottom - 1
      Tmp = Int(Rnd() * k) + Bottom
      If Darr(Tmp) = 0 Then Darr(Tmp) = Tmp
      Arr(i, 1) = Darr(Tmp)
      If Darr(ik) = 0 Then Darr(Tmp) = ik Else Darr(Tmp) = Darr(ik)
      k = k - 1
    Next i
    UniqueRandom = Arr
  End If
End Function
 
Upvote 0
Dim Arr() As Long, Darr() As Long, Tmp As Long, i As Long, k As Long, ik As Long
Sao mình ghét mấy cái Darr hay (Sarr) này ghê! Chẳng đúng chuẩn mực tên biến tí nào!
Biết rằng việc đặt tên biến là tùy sở thích, code chạy chính xác vẫn quan trọng hơn. Tuy nhiên, nếu tất cả mọi người đều tuân thủ 1 nguyên tắc chung thì việc đọc code sẽ trở nên rất dễ dàng (liếc qua đã hiểu)
Các bạn có tưởng tượng ngày nào đó chúng ta lập nhóm viết phần mềm rồi trưởng dự án giao cho mỗi người viết 1 module... Khi ấy mà mỗi người viết mỗi kiểu thì đố mà kiểm tra được đấy (được cũng mất rất nhiều thời gian)
Trên mạng người ta kháo nhau rằng: 1 người Việt Nam có thể giỏi hơn 1 người Nhật hoặc Hàn Quốc nhưng 10 người Việt Nam cộng lại thì.. dở ẹc. Tôi tin rằng người ta đang muốn nói đến vấn đề làm việc nhóm
Hãy tham khảo các trang lập trình nước ngoài (nhất là trang từ MS) hoặc đọc tài liệu về các hàm API, các bạn sẽ thấy người ta viết rất chuẩn mực (ngay từ khâu đặt tên biến)
Với người mới tập tành VBA tôi không đề cập, riêng bạn hieuCD (và nhiều bạn khác) đã giỏi lắm rồi, cũng đến lúc các bạn nên chăm chút cho các phần mà tôi đề cập ở trên đi là vừa
Nếu ý kiến cá nhân tôi có làm mích lòng ai đó thì xem như tôi chưa nói gì (tại thấy... ngứa miệng chút)
 
Upvote 0
Sao mình ghét mấy cái Darr hay (Sarr) này ghê! Chẳng đúng chuẩn mực tên biến tí nào!
Biết rằng việc đặt tên biến là tùy sở thích, code chạy chính xác vẫn quan trọng hơn. Tuy nhiên, nếu tất cả mọi người đều tuân thủ 1 nguyên tắc chung thì việc đọc code sẽ trở nên rất dễ dàng (liếc qua đã hiểu)
Các bạn có tưởng tượng ngày nào đó chúng ta lập nhóm viết phần mềm rồi trưởng dự án giao cho mỗi người viết 1 module... Khi ấy mà mỗi người viết mỗi kiểu thì đố mà kiểm tra được đấy (được cũng mất rất nhiều thời gian)
Trên mạng người ta kháo nhau rằng: 1 người Việt Nam có thể giỏi hơn 1 người Nhật hoặc Hàn Quốc nhưng 10 người Việt Nam cộng lại thì.. dở ẹc. Tôi tin rằng người ta đang muốn nói đến vấn đề làm việc nhóm
Hãy tham khảo các trang lập trình nước ngoài (nhất là trang từ MS) hoặc đọc tài liệu về các hàm API, các bạn sẽ thấy người ta viết rất chuẩn mực (ngay từ khâu đặt tên biến)
Với người mới tập tành VBA tôi không đề cập, riêng bạn hieuCD (và nhiều bạn khác) đã giỏi lắm rồi, cũng đến lúc các bạn nên chăm chút cho các phần mà tôi đề cập ở trên đi là vừa
Nếu ý kiến cá nhân tôi có làm mích lòng ai đó thì xem như tôi chưa nói gì (tại thấy... ngứa miệng chút)
Do quen thôi, mới đầu chép code của các bạn trên diễn đàn rồi viết theo, riết thành quen nhìn là biết tác dụng của các biến, cũng đổi cách đặt biến mấy lần nhưng cuối code nhìn không ra
Viết code vui thôi, chỉ có mấy lệnh xào tới xào lui là hết vốn
chúc bạn 1 tối vui
 
Upvote 0
Đề tài này cũng lâu lắm rồi bạn à (năm 2009) và sau đó đã được cải tiến rất nhiều
Mã:
Function UniqueRandNum(ByVal Bottom As Long, ByVal Top As Long, ByVal Amount As Long)
  Dim i As Long, lPos As Long, n As Long, lTmp As Long, idx As Long
  'Application.Volatile '<--- Neu muon gia tri thay doi khi bam F9
  If Top > Bottom Then
    If Amount > Top - Bottom + 1 Then Amount = Top - Bottom + 1
    ReDim arr(Bottom To Top) As Long
    ReDim aDes(1 To Amount, 1 To 1)
    n = Top - Bottom + 1
    For i = 1 To Amount
      idx = n + Bottom - 1
      lPos = Int(Rnd() * n) + Bottom
      If arr(lPos) = 0 Then arr(lPos) = lPos
      If arr(idx) = 0 Then arr(idx) = idx
      aDes(i, 1) = arr(lPos)
      lTmp = arr(lPos): arr(lPos) = arr(idx): arr(idx) = lTmp
      n = n - 1
    Next
    UniqueRandNum = aDes
   End If
End Function
Nhưng hàm này vẫn bị lỗi, lỗi rất khó phát hiện.Untitled.png
 
Upvote 0
Đề tài này có từ năm 2009, năm mình mới gia nhập diễn đàn, đọc xong code của thầy Ndu mình thấy ....một đống đom đóm trước mặt, ngứa miệng ...hét
Em đi RỪNG CHƯA THAY LÁ
Đến bi giờ võ vẽ được tí code, đọc xong bài #97 của bạn Hiếu CD lại ngứa miệng....hét:
Em về RỪNG LÁ CHƯA THAY
Híc
Bi giờ ( lại bi giờ) tui xin hỏi các thầy, các chú & các anh trong hội Người Cao Tuổi ở GPE viết bài này ( Tạo dãy số ngẫu nhiên không trùng) kiểu nào ( với điều kiện số lần lặp để lấy ngẫu nhiên ít nhất) để khỏi bị lỗi như bài #100, Ai viết được sẽ....có thưởng (Bác Sa, Ba Tê thì thưởng 1 xị "gụ", anh em khác thưởng tượng trưng 2 lon bia (tự chọn)
Thân
 
Lần chỉnh sửa cuối:
Upvote 0
Đề tài này có từ năm 2009, năm mình mới gia nhập diễn đàn, đọc xong code của thầy Ndu mình thấy ....một đống đom đóm trước mặt, ngứa miệng ...hét
Em đi RỪNG CHƯA THAY LÁ
Đến bi giờ võ vẽ được tí code, đọc xong bài #97 của bạn Hiếu CD lại ngứa miệng....hét:
Em về RỪNG LÁ CHƯA THAY
Híc
Bi giờ ( lại bi giờ) tui xin hỏi các thầy, các chú & các anh trong hội Người Cao Tuổi ở GPE viết bài này ( Tạo dãy số ngẫu nhiên không trùng) kiểu nào ( với điều kiện số lần lặp để lấy ngẫu nhiên ít nhất) để khỏi bị lỗi như bài #100, Ai viết được sẽ....có thưởng (Bác Sa, Ba Tê thì thưởng 1 xị "gụ", anh em khác thưởng tượng trưng 2 lon bia (tự chọn)
Thân

vậy là kèo này chỉ dành cho các bậc cha chú thôi. Các thiếu nhi chưa đủ tuổi chỉ được phép ngồi nhìn các bô lão "nhậu". :(:(
 
Upvote 0
Đề tài này có từ năm 2009, năm mình mới gia nhập diễn đàn, đọc xong code của thầy Ndu mình thấy ....một đống đom đóm trước mặt, ngứa miệng ...hét
Em đi RỪNG CHƯA THAY LÁ
Đến bi giờ võ vẽ được tí code, đọc xong bài #97 của bạn Hiếu CD lại ngứa miệng....hét:
Em về RỪNG LÁ CHƯA THAY
Híc
Bi giờ ( lại bi giờ) tui xin hỏi các thầy, các chú & các anh trong hội Người Cao Tuổi ở GPE viết bài này ( Tạo dãy số ngẫu nhiên không trùng) kiểu nào ( với điều kiện số lần lặp để lấy ngẫu nhiên ít nhất) để khỏi bị lỗi như bài #100, Ai viết được sẽ....có thưởng (Bác Sa, Ba Tê thì thưởng 1 xị "gụ", anh em khác thưởng tượng trưng 2 lon bia (tự chọn)
Thân
Nạp 1/2 xị nếp Long An, nắn lại gân cốt, thử sức xem sao
Mã:
Function UniqueRandom(ByVal Bottom As Long, ByVal Top As Long, ByVal N As Long) As Variant
  Dim Arr() As Long, Darr() As Variant, Tmp As Long, i As Long, k As Long
  If Top > Bottom Then
    If N > Top - Bottom + 1 Then N = Top - Bottom + 1
    ReDim Darr(1 To Top - Bottom + 1):  ReDim Arr(1 To N, 1 To 1)
    k = Top - Bottom + 1
    For i = 1 To N
      Tmp = Int(Rnd() * k) + 1
      If Darr(Tmp) = "" Then Darr(Tmp) = Tmp + Bottom - 1
      Arr(i, 1) = Darr(Tmp)
      If Darr(k) = "" Then Darr(Tmp) = k + Bottom - 1 Else Darr(Tmp) = Darr(k)
      k = k - 1
    Next i
    UniqueRandom = Arr
  End If
End Function
Nếu lỡ được thưởng, xin được phép chia cho anh chị trong hội người cao tuổi GPE :pimp:
chúc các bạn một ngày vui/-*+//-*+//-*+/
 
Upvote 0
Không hiểu sao em dùng hàm của Thầy ndu vẫn bị lỗi trùng số. Em có sưu tầm được hàm ESPshuffle rất hay, tốc độ thì khỏi bàn, mà thử nhiều lần vẫn chưa lần nào bị trùng số. Em gửi kèm theo đây để các thầy tham khảo và cho ý kiến :)
Mã:
 Sub ESPshuffle(ByRef r As Range)
   ' fill the given range with unique random numbers 1..n
   ' where n is the number of cells of the range
   ' 2015-09-20 E/S/P
   ' algorithm: preset a collection with indices 1..n (= unique)
   ' and preserve uniqueness when selecting index at random

   Dim n As Long, nrows As Long, ncols As Long
   Dim i As Long, j As Long, idx As Long
   Dim values() As Long
   Dim arr As Variant

   arr = r  ' range to array, cell content doesnt matter
   nrows = UBound(arr, 1)
   ncols = UBound(arr, 2)
   n = nrows * ncols
   ' preset values, non-random, so unique
   ReDim values(1 To n)
   For i = 1 To n
       values(i) = i
   Next i

   Randomize
   For i = 1 To nrows
       For j = 1 To ncols
           ' choose a random element/index AMONG the remaining
           idx = Int(n * Rnd + 1) ' index in 1..n
           arr(i, j) = values(idx)
           ' remove that element =
           ' preserve the last element in array, then shorten it by 1
           values(idx) = values(n)
           n = n - 1
       Next j
   Next i

   ' fill cells in sheet
   r = arr
End Sub
Nguồn: [URL]https://stackoverflow.com/questions/32674682/generate-truly-random-numbers-in-range-of-cells-using-vba[/URL]
 
Lần chỉnh sửa cuối:
Upvote 0

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

Back
Top Bottom