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

Liên hệ QC
anhtuan1066

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,047
Lần chỉnh sửa cuối:
Sắp xếp theo thời gian sắp xếp theo bầu chọn
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
Nhấp chuột vào đây để mở rộng...

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
tuyphongkg đã viết:
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é!
Nhấp chuột vào đây để mở rộng...
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
ndu96081631 đã viết:
Ẹ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
Nhấp chuột vào đây để mở rộng...

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
huynhthanhlin đã viết:
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.
Nhấp chuột vào đây để mở rộng...
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
ndu96081631 đã viết:
Ẹ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]
Nhấp chuột vào đây để mở rộng...
 
Upvote 0
toanxuan đã viết:
ndu96081631 đã viết:
Ẹ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
Nhấp chuột vào đây để mở rộng...
Nhấp chuột vào đây để mở rộng...
 
Upvote 0
anhtuan1066 đã viết:
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)
Nhấp chuột vào đây để mở rộng...
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
huyhoang1768 đã viết:
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
Nhấp chuột vào đây để mở rộ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
tom742 đã viết:
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ố đó).
Nhấp chuột vào đây để mở rộng...

Đã 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
VetMini đã viết:
Đã 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.
Nhấp chuột vào đây để mở rộng...

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
tom742 đã viết:
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ố đó).
Nhấp chuột vào đây để mở rộng...

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
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

ptm0412
Hàm XLOOKUP: Có thể bạn chưa biết hết tính năng và ứng dụng
    • Thích
    • Yêu thích
    • Cảm ơn
Trả lời
2
Đọc
8K
maikhoamt
maikhoamt
phammaihuong90
Hàm tìm ngày gần nhất đạt được số lượng mục tiêu
Trả lời
9
Đọc
216
Phan Thế Hiệp
Phan Thế Hiệp
K
Nhờ mọi người hỗ trợ giúp mình về tìm kiếm trong VBA. Mình sẽ gửi chút chi phí cafe cám ơn nhiều ạ
    • Cười
Trả lời
16
Đọc
213
ptm0412
ptm0412
1
Xin hỗ trợ về tính tổng các dòng loại trừ dòng ẩn nhưng các dòng không liền nhau
Trả lời
5
Đọc
110
VetMini
V
L
Các lấy công thức
Trả lời
5
Đọc
80
VetMini
V
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom