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

anhtuan1066 · 7/9/09

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)

HieuCD · 21/11/20

......

domjnjc · 21/11/20

CHAOQUAY đã viết:
Cách của bạn có lẽ phải chờ rất lâu mới có kết quả.
Theo code của bạn: lập tổ hợp chập 50 của 101 phần tử, sau đó so sánh với 10 số cho trước.
Dùng hàm COMBIN(101,50) để tính, số tổ hợp có thể > 10^29, đây là chưa kể trường hợp lặp lại nhiều lần 1 tổ hợp -> để so sánh đạt yêu cầu với 10 số cho trước có lẽ phải chờ hơi lâu
Tốt nhất là bạn loại trừ 10 số ngay từ đầu khỏi tập cho trước, sau đó lấy ngẫu nhiên.

Bài đã được tự động gộp: 20/11/20

@domjnjc
Hàm xyz ở trên, bạn nhập thế nào

dạ vâng, để so sánh với 10 số thì tương đối lâu và chủ yếu là nó bị lỗi out stack space nên chắc cách đó không khả thi rồi.
còn về hàm xyz, ví dụ em nhập như sau: =xyz(100,110,{101}) thì có lúc ra 9 kết quả, lúc ra 10 kết quả a ạ

Phuocam · 21/11/20

domjnjc đã viết:
dạ vâng, để so sánh với 10 số thì tương đối lâu và chủ yếu là nó bị lỗi out stack space nên chắc cách đó không khả thi rồi.
còn về hàm xyz, ví dụ em nhập như sau: =xyz(100,110,{101}) thì có lúc ra 9 kết quả, lúc ra 10 kết quả a ạ

Theo bạn, ra 9 đúng hay ra 10 đúng?

domjnjc · 21/11/20

HieuCD đã viết:
" tập hợp cho trước " và " các phần tử bỏ đi tùy ý " bạn ghi nhận vào đâu?

Em muốn ghi nhận vào code luôn được không ạ? ví dụ như trong file test e gửi bên trên, khi cần điều chỉnh dãy số cần lấy ra thì em chỉnh code ở phần sub
Range("'test'!A1:A50").Value = UniqueRandomNum(100, 200, 50) như thay A50 thành A55 và 50 thành 55,..., nên em muốn tương tự như vậy, khi muốn điều chỉnh dãy ngẫu nhiên cần lấy, chỉ cần nhập vào code phần sub

Bài đã được tự động gộp: 21/11/20

phuocam đã viết:
Theo bạn, ra 9 đúng hay ra 10 đúng?

kết quả 10 là đúng, em không hiểu lại có lúc ra 9 ạ

Phuocam · 21/11/20

domjnjc đã viết:
kết quả 10 là đúng, em không hiểu lại có lúc ra 9 ạ

Thử lại:

Mã:

Function zzz(dau, cuoi, loaitru)
Dim mang, Kq
Dim i, j, k, rd, temp
Dim pt As Long
ReDim mang(dau To cuoi)
For Each j In loaitru
    mang(j) = 1
    k = k + 1
Next j

pt = cuoi - dau + 1 - k
ReDim Kq(1 To pt)
k = 0
For i = dau To cuoi
    If mang(i) = "" Then
        k = k + 1
        Kq(k) = i
    End If
Next i

Randomize
For i = 1 To pt
    rd = Int(Rnd() * pt) + 1
    temp = Kq(i)
    Kq(i) = Kq(rd)
    Kq(rd) = temp
Next i
zzz = Join(Kq)
End Function

domjnjc · 21/11/20

phuocam đã viết:

Thử lại:

Mã:

Function zzz(dau, cuoi, loaitru)
Dim mang, Kq
Dim i, j, k, rd, temp
Dim pt As Long
ReDim mang(dau To cuoi)
For Each j In loaitru
    mang(j) = 1
    k = k + 1
Next j

pt = cuoi - dau + 1 - k
ReDim Kq(1 To pt)
k = 0
For i = dau To cuoi
    If mang(i) = "" Then
        k = k + 1
        Kq(k) = i
    End If
Next i

Randomize
For i = 1 To pt
    rd = Int(Rnd() * pt) + 1
    temp = Kq(i)
    Kq(i) = Kq(rd)
    Kq(rd) = temp
Next i
zzz = Join(Kq)
End Function

em cảm ơn, ok rồi a ạ!

Phuocam · 21/11/20

domjnjc đã viết:
em cảm ơn, ok rồi a ạ!

Rút gọn còn 2 vòng lặp:

PHP:

Function xxx(dau, cuoi, loaitru)
Dim mang, Kq
Dim i, j, k, rd

ReDim mang(dau To cuoi)
For Each j In loaitru
    mang(j) = 1
    k = k + 1
Next j

ReDim Kq(1 To (cuoi - dau + 1 - k))
k = 0
Randomize
For i = dau To cuoi
    If mang(i) = "" Then
        k = k + 1
        rd = Int(Rnd() * k) + 1
        Kq(k) = Kq(rd)
        Kq(rd) = i
    End If
Next i

xxx = Join(Kq)
End Function

ndu96081631 · 21/11/20

phuocam đã viết:

Rút gọn còn 2 vòng lặp:

PHP:

Function xxx(dau, cuoi, loaitru)
Dim mang, Kq
Dim i, j, k, rd

ReDim mang(dau To cuoi)
For Each j In loaitru
    mang(j) = 1
    k = k + 1
Next j

ReDim Kq(1 To (cuoi - dau + 1 - k))
k = 0
Randomize
For i = dau To cuoi
    If mang(i) = "" Then
        k = k + 1
        rd = Int(Rnd() * k) + 1
        Kq(k) = Kq(rd)
        Kq(rd) = i
    End If
Next i

xxx = Join(Kq)
End Function

Trường hợp số loại trừ không nằm trong khoảng dau - cuoi thì sao? Ví dụ:

Mã:

=xxx(1,10,{1,3,5,7,9,11})

Không có thì bỏ qua chứ sao lại lỗi? Tôi nghĩ là vậy!

HieuCD · 21/11/20

phuocam đã viết:

Rút gọn còn 2 vòng lặp:

PHP:

Function xxx(dau, cuoi, loaitru)
Dim mang, Kq
Dim i, j, k, rd

ReDim mang(dau To cuoi)
For Each j In loaitru
    mang(j) = 1
    k = k + 1
Next j

ReDim Kq(1 To (cuoi - dau + 1 - k))
k = 0
Randomize
For i = dau To cuoi
    If mang(i) = "" Then
        k = k + 1
        rd = Int(Rnd() * k) + 1
        Kq(k) = Kq(rd)
        Kq(rd) = i
    End If
Next i

xxx = Join(Kq)
End Function

Nếu chỉ lấy N Kết quả thì sao

CHAOQUAY · 21/11/20

HieuCD đã viết:
Nếu chỉ lấy N Kết quả thì sao

Thêm điều kiện so sánh k = N để thoát vòng lặp thứ 2 chắc có lẽ là được.

domjnjc · 21/11/20

HieuCD đã viết:
Nếu chỉ lấy N Kết quả thì sao

CHAOQUAY đã viết:
Thêm điều kiện so sánh k = N để thoát vòng lặp thứ 2 chắc có lẽ là được.

xin anh chỉ giúp thêm trường hợp chỉ lấy N số với ạ,

CHAOQUAY · 21/11/20

domjnjc đã viết:
xin anh chỉ giúp thêm trường hợp chỉ lấy N số với ạ,

Mượn code của bài 151, bạn thử xem

Mã:

Option Explicit

'Function xxx(dau, cuoi, loaitru)
Function xxx(dau, cuoi, loaitru, soluongCanlay)
Dim mang, Kq
Dim i, j, k, rd

ReDim mang(dau To cuoi)
For Each j In loaitru
    mang(j) = 1
    k = k + 1
Next j

ReDim Kq(1 To (cuoi - dau + 1 - k))
k = 0
Randomize
For i = dau To cuoi
    If mang(i) = "" Then
        k = k + 1
        rd = Int(Rnd() * k) + 1
        Kq(k) = Kq(rd)
        Kq(rd) = i
       
        If k = soluongCanlay Then Exit For '<---
    End If
Next i

'xxx = Join(Kq)
xxx = Trim(Join(Kq))
End Function

---
Sửa lại cú pháp ví dụ: =xxx(100,200,{101},3)

domjnjc · 21/11/20

CHAOQUAY đã viết:

Mượn code của bài 151, bạn thử xem

Mã:

Option Explicit

'Function xxx(dau, cuoi, loaitru)
Function xxx(dau, cuoi, loaitru, soluongCanlay)
Dim mang, Kq
Dim i, j, k, rd

ReDim mang(dau To cuoi)
For Each j In loaitru
    mang(j) = 1
    k = k + 1
Next j

ReDim Kq(1 To (cuoi - dau + 1 - k))
k = 0
Randomize
For i = dau To cuoi
    If mang(i) = "" Then
        k = k + 1
        rd = Int(Rnd() * k) + 1
        Kq(k) = Kq(rd)
        Kq(rd) = i
      
        If k = soluongCanlay Then Exit For '<---
    End If
Next i

'xxx = Join(Kq)
xxx = Trim(Join(Kq))
End Function

---
Sửa lại cú pháp ví dụ: =xxx(100,200,{101},3)

em thử và hiển thị kết quả là dãy từ bé đến lớn, khi đạt đủ số lượng cần lấy chứ nó không được ngẫu nhiên.
ví dụ: =xxx(100,200,{101},3), thì kết quả chỉ hiện là tập hợp các số 100,102,103

Phuocam · 21/11/20

domjnjc đã viết:
em thử và hiển thị kết quả là dãy từ bé đến lớn, khi đạt đủ số lượng cần lấy chứ nó không được ngẫu nhiên.
ví dụ: =xxx(100,200,{101},3), thì kết quả chỉ hiện là tập hợp các số 100,102,103

Thử UDF này:

PHP:

Function zzz(ByVal dau As Long, ByVal cuoi As Long, ByVal loaitru As Variant, Optional ByVal soluong As Long = 0)
Dim mang, Kq
Dim i, j, k, rd, temp
Dim pt As Long
ReDim mang(dau To cuoi)
For Each j In loaitru
    If j >= dau And j <= cuoi Then
        mang(j) = 1
        k = k + 1
    End If
Next j

pt = cuoi - dau + 1 - k
ReDim Kq(1 To pt)
k = 0
For i = dau To cuoi
    If mang(i) = "" Then
        k = k + 1
        Kq(k) = i
    End If
Next i
If soluong = 0 Or soluong > pt Then soluong = pt
    
Randomize
For i = 1 To soluong
    rd = Int(Rnd() * pt) + 1
    temp = Kq(i)
    Kq(i) = Kq(rd)
    Kq(rd) = temp
Next i
ReDim Preserve Kq(1 To soluong)
zzz = Join(Kq)
End Function

CHAOQUAY · 21/11/20

domjnjc đã viết:
em thử và hiển thị kết quả là dãy từ bé đến lớn, khi đạt đủ số lượng cần lấy chứ nó không được ngẫu nhiên.
ví dụ: =xxx(100,200,{101},3), thì kết quả chỉ hiện là tập hợp các số 100,102,103

Bài trên chỉ để ý tới số lượng, bạn tìm code mới của @phuocam mà dùng

domjnjc · 21/11/20

CHAOQUAY đã viết:
Bài trên chỉ để ý tới số lượng, bạn tìm code mới của @phuocam mà dùng

phuocam đã viết:

Thử UDF này:

PHP:

Function zzz(ByVal dau As Long, ByVal cuoi As Long, ByVal loaitru As Variant, Optional ByVal soluong As Long = 0)
Dim mang, Kq
Dim i, j, k, rd, temp
Dim pt As Long
ReDim mang(dau To cuoi)
For Each j In loaitru
    If j >= dau And j <= cuoi Then
        mang(j) = 1
        k = k + 1
    End If
Next j

pt = cuoi - dau + 1 - k
ReDim Kq(1 To pt)
k = 0
For i = dau To cuoi
    If mang(i) = "" Then
        k = k + 1
        Kq(k) = i
    End If
Next i
If soluong = 0 Or soluong > pt Then soluong = pt
   
Randomize
For i = 1 To soluong
    rd = Int(Rnd() * pt) + 1
    temp = Kq(i)
    Kq(i) = Kq(rd)
    Kq(rd) = temp
Next i
ReDim Preserve Kq(1 To soluong)
zzz = Join(Kq)
End Function

Đúng cái em cần rồi. Many thanks!

excel_lv1.5 · 21/11/20

domjnjc đã viết:
Dạ, em cần sự trợ giúp như sau ạ:
1/: em muốn tạo dãy số ngẫu nhiên từ một tập số cho trước có loại trừ đi một số phần tử, và muốn từng số đó hiển thị theo từng dòng và dãy số đó là số nguyên >=0, (em cũng thử test theo function của anh nhưng không hiểu sao nó thiếu mất mấy số nằm ngoài tập loại trừ em cho vào)
2/: em thử kết hợp function với điều kiện khác để loại số, như trong file đính kèm thì em kết hợp kiểu "bé tập đi" thui ạ, nhưng gặp vấn đề lỗi out stack space!, bấm sub nó chỉ quay đến một mức rồi dừng lại, liệu có cách nào khắc phục không ạ?

Một cách dùng Power query, chuột phải vào bảng Query1 refresh để thay đổi kết quả

ndu96081631 · 21/11/20

phuocam đã viết:

Thử UDF này:

PHP:

Function zzz(ByVal dau As Long, ByVal cuoi As Long, ByVal loaitru As Variant, Optional ByVal soluong As Long = 0)
Dim mang, Kq
Dim i, j, k, rd, temp
Dim pt As Long
ReDim mang(dau To cuoi)
For Each j In loaitru
    If j >= dau And j <= cuoi Then
        mang(j) = 1
        k = k + 1
    End If
Next j

pt = cuoi - dau + 1 - k
ReDim Kq(1 To pt)
k = 0
For i = dau To cuoi
    If mang(i) = "" Then
        k = k + 1
        Kq(k) = i
    End If
Next i
If soluong = 0 Or soluong > pt Then soluong = pt
   
Randomize
For i = 1 To soluong
    rd = Int(Rnd() * pt) + 1
    temp = Kq(i)
    Kq(i) = Kq(rd)
    Kq(rd) = temp
Next i
ReDim Preserve Kq(1 To soluong)
zzz = Join(Kq)
End Function

Biến loaitru phải nên là dạng Optional (có hoặc không cũng được). Ví dụ:

Mã:

=zzz(1,10,{2,4},5)

Có nghĩa là lấy 5 phần tử ngẫu nhiên từ 1 đến 10, loại trừ số 2 và số 4
nhưng nếu là vầy

Mã:

=zzz(1,10,,5)

thì có nghĩa là lấy 5 phần tử ngẫu nhiên từ 1 đến 10, không loại trừ gì cả
Ngoài ra nếu loaitru chi là 1 phần tử duy nhất (số 2 chẳng hạn) thì code phải cho phép viết theo dạng

Mã:

=zzz(1,10,2,5)

mà không cần phải là:

Mã:

=zzz(1,10,{2},5)

----------------------------------------
Vân... vân... phải sửa nhiều lắm!
Tôi đang tự hỏi: 3 vòng lập liệu có nhiều lắm không?

Phuocam · 21/11/20

. .

hvt268 · 13/11/23

ndu96081631 đã viết:
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

Cái code của bạn cũng rất hay nhưng nó không tạo chuỗi số mới khi load lại hoặc thay đổi một giá trị ở ô khác

Bài đã được tự động gộp: 13/11/23

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

Bạn cho hỏi là làm sao để khi nó tự tạo ra một dãy số mới khi mình thay đổi một giá trị trong bảng (kiểu như hàm rand có sẵn vậy)

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

Thành viên gạo cội

File đính kèm

Chuyên gia GPE

Thành viên chính thức

Thành viên mới

Thành viên chính thức

Thành viên mới

Thành viên chính thức

Thành viên mới

Huyền thoại GPE

Chuyên gia GPE

Thành viên gắn bó

Thành viên chính thức

Thành viên gắn bó

Thành viên chính thức

Thành viên mới

Thành viên gắn bó

Thành viên chính thức

Thành viên tích cực

File đính kèm

Huyền thoại GPE

Thành viên mới

Thành viên chính thức

Facebook

Group