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

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
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,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:
Sắp xếp theo thời gian sắp xếp theo bầu chọn
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!
 
Upvote 0
mesavn04 đã viết:
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]
Nhấp chuột vào đây để mở rộng...

Thử code ở đây xem: http://www.giaiphapexcel.com/dienda...ẫu-nhiên-không-trùng.27286/page-5#post-786622
 
Upvote 0
Đổ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ử... :p
 
Upvote 0
.
 
Lần chỉnh sửa cuối:
Upvote 0
minahnh0011 đã viết:
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
Nhấp chuột vào đây để mở rộng...
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
 
Upvote 0
minahnh0011 đã viết:
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
Nhấp chuột vào đây để mở rộng...
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ự)
PHP: 
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
 

File đính kèm

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


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

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

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

File đính kèm

Upvote 0
datlm1988 đã viết:
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!
Nhấp chuột vào đây để mở rộng...
- 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
 
Upvote 0
Hi mọi ngươi,
Mình có 1 bài toán quá khó khăn với mình nhưng chắc khá dễ dàng với nhưng cao thủ trong diễn đàn.
Mình đang cần 1 hàm random không trùng trong 1 dãy số cố định và đồng thời loại bỏ 1 vài số đặc biệt trong dãy số này.
Ví dụ cụ thể như sau:
Mình cần random không trùng lặp khoảng 600-700 số trong dãy từ 6000-6999 nhưng đồng thời có 1 vài số đặc biệt mình cũng không muốn lặp lại trong dãy này như 6969,6888,6999,6789 và 1 vài số cụ thể khác.
Mọi người có thể chỉnh sửa hàm này theo mô tả bên trên dùm mình được không?
P/S mình khá mù về mảng này nên mong mọi người giúp đỡ.
 
Upvote 0
Chào các anh, em rất vui khi tìm được công thức excel của anh về Tạo dãy số ngẫu nhiên không trùng tại thread này https://www.giaiphapexcel.com/diendan/threads/tạo-dãy-số-ngẫu-nhiên-không-trùng.27286/
Nó giúp ích em nhiều trong công việc, tuy nhiên em chỉ xài được nó khi khối theo cột và Ctrl+Shift+Enter, lúc này kết quả sẽ trả ra ngẫu nhiên như anh nói.
tuy nhiên nếu em khối theo dòng và Ctrl+Shift+Enter thì ra kết quả không ngẫu nhiên mà hoàn toàn giống nhau.
Anh cho em hỏi có cách nào để sửa lỗi này không ạ, em cám ơn anh nhiều.
 
Upvote 0
hunglt1994 đã viết:
Chào các anh, em rất vui khi tìm được công thức excel của anh về Tạo dãy số ngẫu nhiên không trùng tại thread này https://www.giaiphapexcel.com/diendan/threads/tạo-dãy-số-ngẫu-nhiên-không-trùng.27286/
Nó giúp ích em nhiều trong công việc, tuy nhiên em chỉ xài được nó khi khối theo cột và Ctrl+Shift+Enter, lúc này kết quả sẽ trả ra ngẫu nhiên như anh nói.
tuy nhiên nếu em khối theo dòng và Ctrl+Shift+Enter thì ra kết quả không ngẫu nhiên mà hoàn toàn giống nhau.
Anh cho em hỏi có cách nào để sửa lỗi này không ạ, em cám ơn anh nhiều.
Nhấp chuột vào đây để mở rộng...
Cái này không phải là lỗi. Đây là tác giả muốn hiển thị kết quả như vậy.
Nếu muốn thành dòng, trong code của link trên, thử thay dòng trên bằng dòng dưới xem sao
Mã: 
 UniqueRandomNum = WorksheetFunction.Transpose(.Keys)
Mã: 
 UniqueRandomNum = .Keys
 
Upvote 0
hunglt1994 đã viết:
Chào các anh, em rất vui khi tìm được công thức excel của anh về Tạo dãy số ngẫu nhiên không trùng tại thread này https://www.giaiphapexcel.com/diendan/threads/tạo-dãy-số-ngẫu-nhiên-không-trùng.27286/
Nó giúp ích em nhiều trong công việc, tuy nhiên em chỉ xài được nó khi khối theo cột và Ctrl+Shift+Enter, lúc này kết quả sẽ trả ra ngẫu nhiên như anh nói.
tuy nhiên nếu em khối theo dòng và Ctrl+Shift+Enter thì ra kết quả không ngẫu nhiên mà hoàn toàn giống nhau.
Anh cho em hỏi có cách nào để sửa lỗi này không ạ, em cám ơn anh nhiều.
Nhấp chuột vào đây để mở rộng...
Bạn thử.Chỉnh 1 chút không biết có đúng ý không.
Mã: 
Function UniqueRandomNum(Bottom As Long, Top As Long, Amount As Long, Optional ByVal dk As Boolean = True)
  '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
    If dk = True Then
        UniqueRandomNum = WorksheetFunction.Transpose(.Keys)
    Else
        UniqueRandomNum = (.Keys)
    End If
  End With
End Function
Mã: 
=UniqueRandomNum(23,30,5,0)
=UniqueRandomNum(23,30,5,1)
 
Upvote 0
CHAOQUAY đã viết:
Cái này không phải là lỗi. Đây là tác giả muốn hiển thị kết quả như vậy.
Nếu muốn thành dòng, trong code của link trên, thử thay dòng trên bằng dòng dưới xem sao
Mã: 
 UniqueRandomNum = WorksheetFunction.Transpose(.Keys)
Mã: 
 UniqueRandomNum = .Keys
Nhấp chuột vào đây để mở rộng...
dạ cám ơn anh, nhờ anh em đãchỉnh lại được công thức và làm được. Một lần nữa cám ơn các anh trong diễn đàn, kiến thức của các anh thật vô biên
Bài đã được tự động gộp:

snow25 đã viết:
Bạn thử.Chỉnh 1 chút không biết có đúng ý không.
Mã: 
Function UniqueRandomNum(Bottom As Long, Top As Long, Amount As Long, Optional ByVal dk As Boolean = True)
  '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
    If dk = True Then
        UniqueRandomNum = WorksheetFunction.Transpose(.Keys)
    Else
        UniqueRandomNum = (.Keys)
    End If
  End With
End Function
Mã: 
=UniqueRandomNum(23,30,5,0)
=UniqueRandomNum(23,30,5,1)
Nhấp chuột vào đây để mở rộng...
dạ em cám ơn anh, em đã thử và làm được ạ!
 
Upvote 0
snow25 đã viết:
Bạn thử.Chỉnh 1 chút không biết có đúng ý không.
Mã: 
Function UniqueRandomNum(Bottom As Long, Top As Long, Amount As Long, Optional ByVal dk As Boolean = True)
  '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
    If dk = True Then
        UniqueRandomNum = WorksheetFunction.Transpose(.Keys)
    Else
        UniqueRandomNum = (.Keys)
    End If
  End With
End Function
Mã: 
=UniqueRandomNum(23,30,5,0)
=UniqueRandomNum(23,30,5,1)
Nhấp chuột vào đây để mở rộng...
Nếu chỉ lấy số nguyên thì thuật toán này không tốt.
Nên viết sao cho kết quả tương thích với mọi dạng của vùng công thức (1 dòng, 1 cột hoặc bảng nhiều dòng nhiều cột) và có thể bỏ luôn tham số số lượng số cần lấy.
 
Upvote 0
huuthang_bd đã viết:
Nếu chỉ lấy số nguyên thì thuật toán này không tốt.
Nên viết sao cho kết quả tương thích với mọi dạng của vùng công thức (1 dòng, 1 cột hoặc bảng nhiều dòng nhiều cột) và có thể bỏ luôn tham số số lượng số cần lấy.
Nhấp chuột vào đây để mở rộng...
Hi em sửa theo bài 1 thôi anh.
 
Upvote 0
snow25 đã viết:
Hi em sửa theo bài 1 thôi anh.
Nhấp chuột vào đây để mở rộng...
Bài đó tròn 10 năm rồi bạn (thật trùng hợp), nó lạc hậu rồi :D.
Mã: 
Function UniqueRandomNum(Bottom As Long, Top As Long)
    Application.Volatile
    Dim CallerRng As Range, NumberSet() As Long, Result() As Long, i As Long, j As Long, k As Long, n As Long
    ReDim NumberSet(1 To Top - Bottom + 1)
    For i = Bottom To Top
        n = n + 1
        NumberSet(n) = i
    Next
    Set CallerRng = Application.Caller
    ReDim Result(1 To CallerRng.Rows.Count, 1 To CallerRng.Columns.Count)
    Randomize
    For i = 1 To UBound(Result, 1)
        For j = 1 To UBound(Result, 2)
            k = Int(Rnd() * n) + 1
            Result(i, j) = NumberSet(k)
            NumberSet(k) = NumberSet(n)
            n = n - 1
        Next
    Next
    UniqueRandomNum = Result
End Function
 

File đính kèm

Upvote 0
huuthang_bd đã viết:
Bài đó tròn 10 năm rồi bạn (thật trùng hợp), nó lạc hậu rồi :D.
Mã: 
Function UniqueRandomNum(Bottom As Long, Top As Long)
    Application.Volatile
    Dim CallerRng As Range, NumberSet() As Long, Result() As Long, i As Long, j As Long, k As Long, n As Long
    ReDim NumberSet(1 To Top - Bottom + 1)
    For i = Bottom To Top
        n = n + 1
        NumberSet(n) = i
    Next
    Set CallerRng = Application.Caller
    ReDim Result(1 To CallerRng.Rows.Count, 1 To CallerRng.Columns.Count)
    Randomize
    For i = 1 To UBound(Result, 1)
        For j = 1 To UBound(Result, 2)
            k = Int(Rnd() * n) + 1
            Result(i, j) = NumberSet(k)
            NumberSet(k) = NumberSet(n)
            n = n - 1
        Next
    Next
    UniqueRandomNum = Result
End Function
Nhấp chuột vào đây để mở rộng...
Anh ơi, em chưa hiểu được code tạm thời chỉ có thể dùng, có cách nào chạy random trong mảng dữ liệu cho trước không ạ (chữ)
Mấy code trên em dùng đều bị lỗi (chỉ bị khi khi sử dụng userform để thực hiện call sub****) => hiện kết quả cũ lên bảng tính (không thể random) ạ
em cảm ơn nhiều ạ
 
Lần chỉnh sửa cuối:
Upvote 0
ndu96081631 đã viết:
Đề 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ấp chuột vào đây để mở rộng...
Dạ cháu dùng sự kiện open và call ... thì kết quả không còn random ạ huhu
 
Upvote 0
ruaonline đã viết:
Dạ cháu dùng sự kiện open và call ... thì kết quả không còn random ạ huhu
Nhấp chuột vào đây để mở rộng...
Lâu lắm không đụng đến hàm này rồi nên cũng quên khá nhiều
Bạn thử sửa lại thế này xem:
Mã: 
Function UniqueRandNum(ByVal Bottom As Long, ByVal Top As Long, Optional 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) Or (Amount <= 0) Then Amount = Top - Bottom + 1
    ReDim arr(Bottom To Top)
    ReDim aDes(1 To Amount, 1 To 1)
    n = Top - Bottom + 1
    Randomize
    For i = 1 To Amount
      idx = n + Bottom - 1
      lPos = Int(Rnd() * n) + Bottom
      If arr(lPos) = vbNullString Then arr(lPos) = lPos
      If arr(idx) = vbNullString 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
ndu96081631 đã viết:
Lâu lắm không đụng đến hàm này rồi nên cũng quên khá nhiều
Bạn thử sửa lại thế này xem:
Mã: 
Function UniqueRandNum(ByVal Bottom As Long, ByVal Top As Long, Optional 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) Or (Amount <= 0) Then Amount = Top - Bottom + 1
    ReDim arr(Bottom To Top)
    ReDim aDes(1 To Amount, 1 To 1)
    n = Top - Bottom + 1
    Randomize
    For i = 1 To Amount
      idx = n + Bottom - 1
      lPos = Int(Rnd() * n) + Bottom
      If arr(lPos) = vbNullString Then arr(lPos) = lPos
      If arr(idx) = vbNullString 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ấp chuột vào đây để mở rộng...
Cháu cảm ơn nhiều ạ, code chạy ok ạ, chỉ có một điều là sau nhiều lần thử, thi thoảng làm treo file ạ.
Mã: 
Sub test()
Dim ch(), da(), i As Long
  tongsoch = 10
  ch = UniqueRd(1, Sheet1.Range("J1").Value, 10)
  Sheet2.Cells(2, 3).Resize(1, 10) = WorksheetFunction.Transpose(ch)
  For i = 3 To tongsoch + 2
    da = UniqueRd(1, 4, 4)
    Sheet2.Cells(3, i).Resize(4, 1) = da
  Next i

End Sub
 
Upvote 0
ruaonline đã viết:
Cháu cảm ơn nhiều ạ, code chạy ok ạ, chỉ có một điều là sau nhiều lần thử, thi thoảng làm treo file ạ.
Mã: 
Sub test()
Dim ch(), da(), i As Long
  tongsoch = 10
  ch = UniqueRd(1, Sheet1.Range("J1").Value, 10)
  Sheet2.Cells(2, 3).Resize(1, 10) = WorksheetFunction.Transpose(ch)
  For i = 3 To tongsoch + 2
    da = UniqueRd(1, 4, 4)
    Sheet2.Cells(3, i).Resize(4, 1) = da
  Next i

End Sub
Nhấp chuột vào đây để mở rộng...
Thử dùng hàm tự tạo
Mã: 
Function NgauNhienKhongTrung(ByVal Bottom&, ByVal Top&, Optional ByVal N& = 0, Optional ByVal bCapNhat As Boolean = False)
  Dim sArr(), Res() As Long, D&, i&, k&
  If bCapNhat Then Application.Volatile ' Thay doi ngau nhien khi bam F9
  If Top > Bottom Then
    D = Top - Bottom + 1
    If (N > D) Or (N <= 0) Then N = D
    ReDim sArr(1 To D)
    ReDim Res(1 To N, 1 To 1)
    Randomize
    For i = 1 To N
      k = Int(Rnd() * D) + 1
      If sArr(k) = Empty Then Res(i, 1) = k + Bottom - 1 Else Res(i, 1) = sArr(k) + Bottom - 1
      If sArr(D) = Empty Then sArr(k) = D Else sArr(k) = sArr(D)
      D = D - 1
    Next
    NgauNhienKhongTrung = Res
   End If
End Function
 
Upvote 0
HieuCD đã viết:
Thử dùng hàm tự tạo
Mã: 
Function NgauNhienKhongTrung(ByVal Bottom&, ByVal Top&, Optional ByVal N& = 0, Optional ByVal bCapNhat As Boolean = False)
  Dim sArr(), Res() As Long, D&, i&, k&
  If bCapNhat Then Application.Volatile ' Thay doi ngau nhien khi bam F9
  If Top > Bottom Then
    D = Top - Bottom + 1
    If (N > D) Or (N <= 0) Then N = D
    ReDim sArr(1 To D)
    ReDim Res(1 To N, 1 To 1)
    Randomize
    For i = 1 To N
      k = Int(Rnd() * D) + 1
      If sArr(k) = Empty Then Res(i, 1) = k + Bottom - 1 Else Res(i, 1) = sArr(k) + Bottom - 1
      If sArr(D) = Empty Then sArr(k) = D Else sArr(k) = sArr(D)
      D = D - 1
    Next
    NgauNhienKhongTrung = Res
   End If
End Function
Nhấp chuột vào đây để mở rộng...
Cảm ơn bác nhiều ạ
 
Upvote 0
HieuCD đã viết:
Thử dùng hàm tự tạo
Mã: 
Function NgauNhienKhongTrung(ByVal Bottom&, ByVal Top&, Optional ByVal N& = 0, Optional ByVal bCapNhat As Boolean = False)
  Dim sArr(), Res() As Long, D&, i&, k&
  If bCapNhat Then Application.Volatile ' Thay doi ngau nhien khi bam F9
  If Top > Bottom Then
    D = Top - Bottom + 1
    If (N > D) Or (N <= 0) Then N = D
    ReDim sArr(1 To D)
    ReDim Res(1 To N, 1 To 1)
    Randomize
    For i = 1 To N
      k = Int(Rnd() * D) + 1
      If sArr(k) = Empty Then Res(i, 1) = k + Bottom - 1 Else Res(i, 1) = sArr(k) + Bottom - 1
      If sArr(D) = Empty Then sArr(k) = D Else sArr(k) = sArr(D)
      D = D - 1
    Next
    NgauNhienKhongTrung = Res
   End If
End Function
Nhấp chuột vào đây để mở rộng...
Em xin chào anh! Em muốn tạo một tập hợp số ngẫu nhiên từ một tập hợp cho trước thì làm như thế nào ạ?, ví dụ tập hợp cho trước là từ 100 đến 1000 nhưng bỏ đi phần tử 101,102,501,502... (các phần tử bỏ đi tùy ý), từ tập đó ta lấy ngẫu nhiên 500 số không trùng chẳng hạn, xin anh giúp đỡ ạ!
 
Upvote 0
domjnjc đã viết:
vâng, danh sách số bỏ đi là 10 số từ 500 đến 509 chẳng hạn ạ, tùy ý ở đây nghĩa là 10 số bỏ đi đó mình có thể thay đổi được ạ, không cố định là 500 đến 509
Nhấp chuột vào đây để mở rộng...
Thử hàm tự tạo
cú pháp ví dụ: =xyz(100,500,{200;201;202})
Kết qua trả về 1 chuỗi
Mã: 
Function xyz(dau, cuoi, loaitru)
Dim mang, Kq
Dim lo, ol
Dim i, j, k
ReDim mang(dau To cuoi)
For Each j In loaitru
    mang(j) = 1
Next j
For j = dau To cuoi
    If mang(j) = "" Then
        mang(dau + k) = j
        k = k + 1
    End If
Next j
ReDim Preserve mang(dau To k + dau)
lo = k
ol = lo
ReDim Kq(1 To lo)
Randomize
For i = lo To 1 Step -1
    j = Int(Rnd() * i) + dau
    Kq(i) = mang(j)
    mang(j) = mang(ol + dau)
    ol = ol - 1
Next i
xyz = Join(Kq)
End Function
---
Dãy số phải là nguyên dương nhé bạn
 
Lần chỉnh sửa cuối:
Upvote 0
CHAOQUAY đã viết:
Thử hàm tự tạo
cú pháp ví dụ: =xyz(100,500,{200;201;202})
Kết qua trả về 1 chuỗi
Mã: 
Function xyz(dau, cuoi, loaitru)
Dim mang, Kq
Dim lo, ol
Dim i, j, k
ReDim mang(dau To cuoi)
For Each j In loaitru
    mang(j) = 1
Next j
For j = dau To cuoi
    If mang(j) = "" Then
        mang(dau + k) = j
        k = k + 1
    End If
Next j
ReDim Preserve mang(dau To k + dau)
lo = k
ol = lo
ReDim Kq(1 To lo)
Randomize
For i = lo To 1 Step -1
    j = Int(Rnd() * i) + dau
    Kq(i) = mang(j)
    mang(j) = mang(ol + dau)
    ol = ol - 1
Next i
xyz = Join(Kq)
End Function
---
Dãy số phải là nguyên dương nhé bạn
Nhấp chuột vào đây để mở rộng...
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 ạ?
 

File đính kèm

Upvote 0
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 ạ?
Nhấp chuột vào đây để mở rộng...
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:

@domjnjc
Hàm xyz ở trên, bạn nhập thế nào
 
Lần chỉnh sửa cuối:
Upvote 0
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:

@domjnjc
Hàm xyz ở trên, bạn nhập thế nào
Nhấp chuột vào đây để mở rộng...
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 ạ
 
Upvote 0
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 ạ
Nhấp chuột vào đây để mở rộng...
Theo bạn, ra 9 đúng hay ra 10 đúng?
 
Upvote 0
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?
Nhấp chuột vào đây để mở rộng...
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:

phuocam đã viết:
Theo bạn, ra 9 đúng hay ra 10 đúng?
Nhấp chuột vào đây để mở rộng...
kết quả 10 là đúng, em không hiểu lại có lúc ra 9 ạ
 
Upvote 0
domjnjc đã viết:
kết quả 10 là đúng, em không hiểu lại có lúc ra 9 ạ
Nhấp chuột vào đây để mở rộng...
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
 
Upvote 0
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
Nhấp chuột vào đây để mở rộng...
em cảm ơn, ok rồi a ạ!
 
Upvote 0
domjnjc đã viết:
em cảm ơn, ok rồi a ạ!
Nhấp chuột vào đây để mở rộng...
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
 
Lần chỉnh sửa cuối:
Upvote 0
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
Nhấp chuột vào đây để mở rộng...
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!
 
Upvote 0
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
Nhấp chuột vào đây để mở rộng...
Nếu chỉ lấy N Kết quả thì sao
 
Upvote 0
domjnjc đã viết:
xin anh chỉ giúp thêm trường hợp chỉ lấy N số với ạ,
Nhấp chuột vào đây để mở rộng...
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)
 
Upvote 0
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)
Nhấp chuột vào đây để mở rộng...
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
 
Upvote 0
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
Nhấp chuột vào đây để mở rộng...
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
 
Upvote 0
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
Nhấp chuột vào đây để mở rộng...
Bài trên chỉ để ý tới số lượng, bạn tìm code mới của @phuocam mà dùng
 
Upvote 0
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
Nhấp chuột vào đây để mở rộ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
Nhấp chuột vào đây để mở rộng...
Đúng cái em cần rồi. Many thanks!
 
Upvote 0
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 ạ?
Nhấp chuột vào đây để mở rộng...
Một cách dùng Power query, chuột phải vào bảng Query1 refresh để thay đổi kết quả
1605938389395.png
 

File đính kèm

Upvote 0
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
Nhấp chuột vào đây để mở rộng...
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?
 
Upvote 0
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
Nhấp chuột vào đây để mở rộng...
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:

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...
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)
 
Lần chỉnh sửa cuối:
Upvote 0
hvt268 đã viết:
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:


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)
Nhấp chuột vào đây để mở rộng...
Trong code, tác giả đã tạm bỏ dòng này để hàm không tự động cập nhật
Mã: 
Application.Volatile '<--- Neu muon gia tri thay doi khi bam F9
Bạn chọn nó là OK
 
Upvote 0
bebo021999 đã viết:
Trong code, tác giả đã tạm bỏ dòng này để hàm không tự động cập nhật
Mã: 
Application.Volatile '<--- Neu muon gia tri thay doi khi bam F9
Bạn chọn nó là OK
Nhấp chuột vào đây để mở rộng...
Cám ơn bạn
bebo021999 đã viết:
Trong code, tác giả đã tạm bỏ dòng này để hàm không tự động cập nhật
Mã: 
Application.Volatile '<--- Neu muon gia tri thay doi khi bam F9
Bạn chọn nó là OK
Nhấp chuột vào đây để mở rộng...
Đã chọn rồi mà không thấy tác dụng gì cả bạn ơi
 
Upvote 0
Mình có xem các bác hướng dẫn và làm file bốc thăm thi đấu loại trực tiếp cho môn Bida, anh em cần có thể lấy tham khảo, Bốc thăm ngẫu nhiên và điền tên vào Bảng thi đấu sẵn luôn nhé!
 

File đính kèm

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...
Nhờ bạn viết giúp mình hàm này với: Daysongaunhien (số hàng; số cột; min; max; bộ số cần tạo; kiểu sắp xếp). Trong đó: dãy số ngẫu nhiên được tạo không trùng lặp, dãy số trong mỗi hàng tăng dần từ trái qua phải; số hàng dưới luôn lớn hơn số hàng trên
 
Upvote 0
vancanhpron đã viết:
Nhờ bạn viết giúp mình hàm này với: Daysongaunhien (số hàng; số cột; min; max; bộ số cần tạo; kiểu sắp xếp). Trong đó: dãy số ngẫu nhiên được tạo không trùng lặp, dãy số trong mỗi hàng tăng dần từ trái qua phải; số hàng dưới luôn lớn hơn số hàng trên
Nhấp chuột vào đây để mở rộng...
Người mà bạn có ý nhờ viết hàm đã xa diễn đàn từ giữa tháng 12/2018 đến nay rồi!
Dù sao bạn cũng cần nêu rõ hơn:
→ Giá trị nhỏ nhất trong hàng dưới có cần lớn hơn trị cực đại của hàm trên hay không?
→ 1 bảng số liệu đã biết số dòng & số cột, cũng có nghĩa là biết được số phần tử trong bảng;
Vậy thì đề bài có thể cụ thể hóa như vầy được không:
Lấy ngẫu nhiên các con số từ 1 đến 999 lắp vô các ô trên bảng tính có 8 dòng & 12 cột
sao cho các số trong hàng hay cột đều tăng dần.

Với đề bài cụ thể này, mình cho rằng có thể có vài ba cách giải & chúc bạn thành công!

PHP: 
Function BangNgauSo(Optional Rws As Byte = 8, Optional Col As Byte = 12, _
    Optional Min_ As Integer = 1, Optional Max_ As Integer = 999)
 Dim J As Integer, W As Integer, Z As Integer, Tmp As Integer
 
 If Rws > 8 Then Rws = 8
 If Col > 12 Then Col = 12
 ReDim Arr(1 To 8, 1 To 12) As String
 Randomize:             Tmp = 1
 For J = 1 To 8
    Tmp = Tmp + 1
    For Z = 1 To 12
        Tmp = 1 + Tmp + 3 * Rnd() \ 1
        Arr(J, Z) = Str(Tmp)
    Next Z
 Next J
 BangNgauSo = Arr()
End Function
 
Lần chỉnh sửa cuối:
Upvote 0
nguyenhung83 đã viết:
Mình có xem các bác hướng dẫn và làm file bốc thăm thi đấu loại trực tiếp cho môn Bida, anh em cần có thể lấy tham khảo, Bốc thăm ngẫu nhiên và điền tên vào Bảng thi đấu sẵn luôn nhé!
Nhấp chuột vào đây để mở rộng...
Đánh độ bi da thì người ta lắc từ túi da ra một viên bi ghi số ngẫu nhiên rối đánh dựa theo số ấy.
Số ấy người chơi giấu chặt chứ đâu có ghi bảng biếc gì.

SA_DQ đã viết:
...
Vậy thì đề bài có thể cụ thể hóa như vầy được không:
Lấy ngẫu nhiên các con số từ 1 đến 999 lắp vô các ô trên bảng tính có 8 dòng & 12 cột
sao cho các số trong hàng hay cột đều tăng dần.
...
Nhấp chuột vào đây để mở rộng...
Thuật toán:
1. chọn lấy ngẫu nhiên theo 1 trong các cách giải trên
2. chép kết quả vào một mảng (nếu không sẵn là một mảng)
3. sort mảng theo thứ tự
4. tuần tự chép kết quả vào mảng m*n. Cột trước hàng sau
 
Lần chỉnh sửa cuối:
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

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

N
  • Question Question
Tạo file lưu trữ dự liệu tự động (10 người xem)
Trả lời
6
Đọc
47
Hoàng Tuấn 868
H
N
Tạo file lưu trữ dữ liệu tự động trên excel. (3 người xem)
Trả lời
4
Đọc
47
nguyenle01
N
ongke0711
  • Question Question
Tra cứu thông tin mã số thuế (cập nhật lại code cũ) (1 người xem)
    • Thích
    • Cảm ơn
    • Yêu thích
Trả lời
9
Đọc
495
ongke0711
ongke0711
Ả
Cách tạo list Data validation không qua trung gian (2 người xem)
Trả lời
45
Đọc
7K
HOADINH84
H
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba (2 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
2 3 4
Trả lời
395
Đọc
47K
phamvanquoc.hanamninh
P
V
  • Question Question
Tạo dữ liệu random cho từng sheet dựa theo dữ liệu có sẵn (1 người xem)
Trả lời
3
Đọc
128
HieuCD
H
hieuxd
  • Question Question
Khi nhập dữ liệu tự động chèn thêm dòng khi số dòng trong bảng mẫu sắp hết (1 người xem)
Trả lời
26
Đọc
25K
dungpham01
D
D
in ra bị thiếu chữ
Trả lời
4
Đọc
86
dankedun
D
Momominh
Hỏi công thức tìm tuần thiếu hàng
Trả lời
1
Đọc
73
hoangtuaotrang_hp_vn
H
2
EM MUỐN TẠO MA TRẬN BIẾN ĐỔI GIÁ TRỊ PHẦN TỬ NGẪU NHIÊN
Trả lời
2
Đọc
67
ptm0412
ptm0412
Emyeuexcel
Cộng 4 tuần theo 1 qui luật qui định
Trả lời
34
Đọc
2K
Emyeuexcel
Emyeuexcel
Gà Con yêu VBA
Mở Pass file excel phiên bản .xlsx , xlsm, xlsb
Trả lời
6
Đọc
288
YêuCN
Y
S
Mở 2 cửa sổ riêng biệt (2 người xem)
Trả lời
31
Đọc
24K
ThanhNgan240723
T
vn81206
TRA CỨU MÃ SỐ THUẾ CÁ NHÂN QUA EXCEL (1 người xem)
    • Buồn
Trả lời
57
Đọc
20K
vovietdung261016
V
PhanTuHuong
CHỌN VÀ SỬ DỤNG MÁY LỌC KHÔNG KHÍ
    • Thích
    • Cảm ơn
Trả lời
7
Đọc
1K
PhanTuHuong
PhanTuHuong
huuthang_bd
Add in SwitchSheet: Quay lại các sheet đã xem trước đó bằng phím tắt (1 người xem)
    • Thích
    • Yêu thích
2
Trả lời
146
Đọc
43K
phong_codon
P
N
  • Question Question
Hỗ trợ tiếng việt trong macro
Trả lời
14
Đọc
607
Quang_Hải
Quang_Hải
N
Cài phần mềm đọc số ra chữ
Trả lời
2
Đọc
142
Nguyễn Duy Tuân
Nguyễn Duy Tuân
T
Em cần hỗ trợ tách nhiều file và đặt tên theo quy ước chung từ bảng 01 excel có sẳng
Trả lời
1
Đọc
122
HUONGHCKT
H
N
hàm đếm theo dòng
Trả lời
1
Đọc
102
dungpham01
D
Xem thêm…

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

Thời gian đếm ngược.

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom