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

[anhtuan1066]

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:

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:

=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:

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)

 

[VetMini]

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ê)

 

[haonlh]

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

 

[motnguoiban2020]

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 ý.

 

[SA_DQ]

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

 

[motnguoiban2020]

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.

 

[ChanhTQ@]

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

 

[motnguoiban2020]

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,

 

[doveandrose]

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 đã

 

[motnguoiban2020]

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.

 

[doveandrose]

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é

 

[motnguoiban2020]

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

 

[motnguoiban2020]

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.

 

[doveandrose]

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

 

[motnguoiban2020]

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ợ.

 

[doveandrose]

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 đó .

 

[befaint]

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

 

[motnguoiban2020]

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ợ.

 

[motnguoiban2020]

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 ?

 

[doveandrose]

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 .

 

[concogia]

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