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)

 

[laulau]

Mọi người có thể tùy biến dãy số sau 2 chữ số thập phân được không?, (VD Từ 95.01-95.99). Thân!

 

[ndu96081631]

Mọi người có thể tùy biến dãy số sau 2 chữ số thập phân được không?, (VD Từ 95.01-95.99). Thân!

Thì bạn tạo dãy số từ 9501 đến 9599, xong chia chúng cho 100 là ra kết quả.

 

[NguyenNgocThuHien]

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

 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]

Thử code ở đây xem: http://www.giaiphapexcel.com/dienda...ẫu-nhiên-không-trùng.27286/page-5#post-786622

 

[hieungxngoc]

Đổi lại giờ muốn tạo dãy số ngẫu nhiên từ những số cho trước và trùng lặp với số lần ít nhất cho trước thì sao nhỉ. Bạn nào làm mẫu cho cái hàm với,

Hàm này ứng dụng để phân chia lịch trực chắc là được, ai làm nhân sự cho ý kiến thử...

 

[HeSanbi]

.

 

[VetMini]

Anh HieuCD ơi có thể viết thành Sub được không, em muốn chạy sub cho file này, anh giúp em

Thì viết 1 cái sub gọi function này và dán kết quả vào sheet.
sub subchaychofilenay()
meData = UniqueRandom(chận dưới, chận trên, số lượng cần)
[A1].resize(ubound(meData)).value = Application.Transform(meData)
end sub

 

[HieuCD]

Anh HieuCD ơi có thể viết thành Sub được không, em muốn chạy sub cho file này, anh giúp em

Bạn xem file, dùng công thức trực tiếp hoặc bấm nút lệnh chạy code

 

[concogia]

Anh HieuCD ơi có thể viết thành Sub được không, em muốn chạy sub cho file này, anh giúp em

Mình thấy có hàm RandBetween mà ít thấy anh em sử dụng. Bài này mình thử viết theo hướng dùng nó thử xem sao
Code cho 1-100; 20: ( các code khác tương tự)

Sub Matrix3()
Dim I, Wf, Vung, Kq, K, kK, iHang, A
    iHang = 20
    Vung = [row(1:100)]
    Set Wf = Application.WorksheetFunction
    ReDim Kq(1 To iHang, 1 To 1)
        For I = UBound(Vung) To 1 Step -1
            A = Wf.RandBetween(1, I)
            K = K + 1: kK = kK + 1
            Kq(K, 1) = Vung(A, 1): Vung(A, 1) = Vung(I, 1)
            If kK = iHang Then Exit For
        Next I
    [E6].Resize(iHang) = Kq
End Sub

 

[Fancis12]

Em vô tình lên đây tìm bài đọc thấy bài đọc này hay quá, nhưng mà trình độ em quá gà chỉ biết một tý về code chứ chưa biết viết. Em muốn hỏi cá bác là muốn tạo ra một dãy số ngẫu nhiên mà trong đó vừa có chữ vừa có số thì phải làm sao, chỉ biết lấy sô ngẫu nhiên còn ký tự thì không biết.
Mong mọi người giúp em.

 

[befaint]

Em vô tình lên đây tìm bài đọc thấy bài đọc này hay quá, nhưng mà trình độ em quá gà chỉ biết một tý về code chứ chưa biết viết. Em muốn hỏi cá bác là muốn tạo ra một dãy số ngẫu nhiên mà trong đó vừa có chữ vừa có số thì phải làm sao, chỉ biết lấy sô ngẫu nhiên còn ký tự thì không biết.
Mong mọi người giúp em.

Thì mình quy ước ký tự là số, sau khi tạo được dãy số theo ý muốn mình tra ngược lại chỗ cái quy ước.

 

[Hoang2013]

Hay là:
Biến kí số thành kí tự số, xâu hết chúng lại thành 1 (gồm kí tự số & các kí tự muốn có);
Sau đó băm chúng ra như băm bèo, sau mỗi lần băm nối chúng lại (thực hiện đến khi chán thì nghỉ giai đoạn)
Sau đó xắc lấy từ đầu đến đít hay ngược lại, tùy í sướng bản thân mỗi người.

 

[Fancis12]

Vậy thì cái mã đó hoặc code đó phải viết làm sao. Giống như quy ước cho bảng chữ cái A=0, B=1..., Vd lấy một số ngẫu nhiên "102675" thì 2 số đầu là ký tự chữ còn 4 số sau là ký tự số. "102675"=BA2675. ra một chuỗi 1 ngàn số như thế đó. Làm mẫu cho em một cái. Cảm ơn mọi người.

 

[NguyenNgocThuHien]

Em vô tình lên đây tìm bài đọc thấy bài đọc này hay quá, nhưng mà trình độ em quá gà chỉ biết một tý về code chứ chưa biết viết. Em muốn hỏi cá bác là muốn tạo ra một dãy số ngẫu nhiên mà trong đó vừa có chữ vừa có số thì phải làm sao, chỉ biết lấy sô ngẫu nhiên còn ký tự thì không biết.
Mong mọi người giúp em.

Có gì đâu, trong vba tạo ra một mảng gồm những số và ký tự mà bạn muốn lấy, ví dụ 1,2,3,"1","2","a","b"..., Giả sử có 10 phần tử, thì lấy ngẫu nhiên từ 1 đến 10.
Giả sử lấy ngẫu nhiên 2 lần được số 1 và 6, thì chuỗi ngẫu nhiên là 1a, vì ở vị trí thứ 6 là ký tự "a"

 

[VetMini]

Vậy thì cái mã đó hoặc code đó phải viết làm sao. Giống như quy ước cho bảng chữ cái A=0, B=1..., Vd lấy một số ngẫu nhiên "102675" thì 2 số đầu là ký tự chữ còn 4 số sau là ký tự số. "102675"=BA2675. ra một chuỗi 1 ngàn số như thế đó. Làm mẫu cho em một cái. Cảm ơn mọi người.

Từ AA đến ZZ có 26*26 = 676 trị.
Dùng 1 trong các hàm đã được chỉ dẫn ở trên, lấy ngấu nhiên 1000 số trong khoảng từ 10000 đến 6769999.

 

[Hoang2013]

Hình như bạn này muốn thực hiện việc cấp biển số xe 1 cách ngẫu nhiên;

Vậy thì nên cho biết cụ thể hơn đi:
Khu vực hay tỉnh thành nào?
5 hay 4 số?
CQ bạn đang cấp loại/dạng biển số nào?

 

[VetMini]

Hình như bạn này muốn thực hiện việc cấp biển số xe 1 cách ngẫu nhiên;

Vậy thì nên cho biết cụ thể hơn đi:
Khu vực hay tỉnh thành nào?
5 hay 4 số?
CQ bạn đang cấp loại/dạng biển số nào?

Biển số xe làm sao cấp kiểu ngẫu nhiên được? Chả lẽ chỉ cấp 1 lần rồi thôi?
Hay đây là một hình thức làm sổ ma. Tôi khai báo rằng cty tôi có 1000 chiếc xe, bây giờ cần nộp sổ chứng từ chi tiêu cho từng chiếc. Khi ấy tôi cần 1000 biển số tạo ngẫu nhiên.

 

[thanganhtuyen]

- 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

Sao em viết code như vậy trong module nhưng vẫn trùng nhau và khi thoát Excel bật lại thì mất code

 

[NguyenNgocThuHien]

Sao em viết code như vậy trong module nhưng vẫn trùng nhau và khi thoát Excel bật lại thì mất code

Gửi file kết quả lên hoặc hình chụp, save file ở định dạng .xlsm thì mới không mất code.

 

[datlm1988]

Mình có 1 vấn đề khi sử dụng code này:
- Yêu cầu là: Chọn 1 dãy 14 tên trong 1 list có 18 tên cho trước.
- Mình đã copy code như các bạn hướng dẫn.
- Vấn đề mình gặp: Khi Enter thì ra 1 tên, tuy nhiên nếu copy câu lệnh và kéo xuống tới dòng thứ 14 thì bị lặp lại + lỗi như file đính kèm. (mình có xem công thức theo mẫu các bạn đưa ra nhưng không thấy khác gì)
Nhờ các bạn hướng dẫn cách khắc phục điểm này .
Xin chân thành cảm ơn!

 

[ndu96081631]

Mình có 1 vấn đề khi sử dụng code này:
- Yêu cầu là: Chọn 1 dãy 14 tên trong 1 list có 18 tên cho trước.
- Mình đã copy code như các bạn hướng dẫn.
- Vấn đề mình gặp: Khi Enter thì ra 1 tên, tuy nhiên nếu copy câu lệnh và kéo xuống tới dòng thứ 14 thì bị lặp lại + lỗi như file đính kèm. (mình có xem công thức theo mẫu các bạn đưa ra nhưng không thấy khác gì)
Nhờ các bạn hướng dẫn cách khắc phục điểm này .
Xin chân thành cảm ơn!

- Quét chọn từ E2 đến E15
- Gõ vào thanh Formula công thức =INDEX($B$2:$B$19,UniqueRandomNum(1,18,14))
- Bấm Ctrl + Shift + Enter để kết thúc
--------------------------------
Vấn đề của bạn là: bạn chưa biết cách dùng