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

Chia sẻ bởi:hands
★★★★★
Quảng cáo

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)

www.giaiphapexcel.com/diendan/threads/t%E1%BA%A1o-d%C3%A3y-s%E1%BB%91-ng%E1%BA%ABu-nhi%C3%AAn-kh%C3%B4ng-tr%C3%B9ng.27286/

Khoá học Trưởng phòng nhân sự
Khóa học SprinGO phù hợp

Khoá học Trưởng phòng nhân sự

Nguồn nhân lực là một trong Tứ trụ kinh doanh của doanh nghiệp, có tác động tới sự tồn tại và phát triển bền...

Xem khóa học
★★★★★ 5 ★ 1 👤 19 ▥ 0
Quảng cáo

Bạn nên đọc

19 Responses

  1. hands says:

    Tôi xin giả lập 1 file, dùng ứng dụng trên để tạo phòng thi
    – Có 146 sinh viên
    – Tạo 5 phòng thì, mỗi phòng 30 sinh viên được lấy ngẫu nhiên từ dử liệu gốc
    Xem file

    UniqueRandomNum

    làm sao viết được đoạn code này cho excel 2007 vậy bác ơi.
    em dowload file về thì dùng dược hưng dùng hàm UniqueRandomNum thì kô có trong excel
    em mong bác chỉ cho em cách tạo để có thể dùng ở mọi nơi.
    em cám ơn bác rất nhiều.

    – 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 InsertModule (để có 1 Module như người ta) rồi hẳn paste code vào

    Lọc danh sách
    1- Phải tạo một Object Dictionary
    2- Phải thêm bẫy lỗi: On Error Resume Next vì Dictionary.Add sẽ bị trùng Key do ngẫu nhiên

    Chúng ta có thể viết code cũng đơn giản thôi, dễ hiểu, không bẫy lỗi, không dùng Dic như sau:
    (code trên viết lại, một số biến thay đổi tên)

    Function RandNum(Btom As Long, Top As Long, Amount As Long)
    ReDim aa(Amount) As Long
         Do
            bb = Int(Rnd() * (Top - Btom + 1)) + Btom
            If InStr(cc, "@" & bb & "@") = 0 Then
                aa(i) = bb
                cc = cc & "@" & bb & "@"
                i = i + 1
            End If
        Loop Until i = Amount
        RandNum = WorksheetFunction.Transpose(aa)
     End Function

    Em cố tự làm nhưng tay nghề em yếu quá. mong các anh chị giúp em lấy ra 1 lần 50 tên nhé.Nhưng phải ngẫu nhiên và những lần như vậy không được trùng nhau nhé. em post lên file excel này mong các anh chị giúp đỡ em nhé, Em chân thành cám ơn

    Hãy dùng code của bạn tạo ra 60000 số ngẫu nhiên trên bảng tính, từ 1 đến 100000 —> Làm xong xem thử tốc độ code của bạn là bao nhiêu giây rồi hẳn bàn tiếp nhé
    (Tốc độ chạy code của "người ta" là < 1 giây đấy —> Còn của bạn = ? )

    1- Đúng là code của tôi chậm hơn do thao tác trên string với số lượng rất lớn, nhưng nó vẫn tốt khi tạo vài trăm số ngẫu nhiên.
    2- Sở dĩ tôi viết hàm trên vì tôi đã trích dẫn lý do: tác giả bảo "…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!", tôi chỉ chứng minh rằng ta vẫn có thể viết code gọn và dễ hiếu
    3- Mong GPE với tinh thần xây dựng là chính, các trao đổi nên dựa trên học thuật.
    * Ưu điểm của Dictionary là không có key trùng; dựa trên đấy tác giả anhtuan1066 viết function ngắn gọn; tuy nhiên việc bẫy lỗi "On Error Resume Next" về phương diện học thuật không phải ai cũng thích (mặc dù nhìn vào code, lỗi chỉ xẩy ra trong vòng lặp đã tiên liệu)
    * Ta có thể loại câu "On Error Resume Next" như sau:

    Function RandNum2(Btom As Long, Top As Long, Amount As Long)
    Set aa = CreateObject("Scripting.Dictionary")
    1:  Do
            bb = Int(Rnd * (Top - Btom + 1)) + Btom
            If aa.Exists(bb) Then GoTo 1
            aa.Add bb
        Loop Until aa.Count = Amount
        RandNum2 = WorksheetFunction.Transpose(aa)
     End Function

    Xin ngừng ngang đây. cảm ơn các bạn đã góp ý

    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:

    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

  2. hands says:

    ngoài ra còn có Collection Object, mà Collection thì khỏi dùng hàm CreateObject, chỉ việc khai báo biến thường lệ; sau đây tôi sẽ viết với Collection để chứng minh ta còn nhiều cách tiếp cận vấn đề. Đương nhiên không dám so hay hơn hàm UniqueRandomNum:

    Sub Test4()
        RandNum2 1, 30, 30
    End Sub
    Sub RandNum2(Btom As Long, Top As Long, Amount As Long)
        If Amount > Top - Bottom + 1 Then Amount = Top - Bottom + 1
        Randomize
        Dim UniNums As New Collection
        Do
            RNum = Int(Rnd() * (Top - Btom + 1)) + Btom
            On Error Resume Next
            UniNums.Add RNum, CStr(RNum)
        Loop Until UniNums.Count = Amount
        For i = 1 To Amount
        ActiveSheet.Cells(i, 1).Value = UniNums.Item(i)
        Next
     End Sub

    Theo tôi, cách nào cũng có cái hay của nó. Nếu là tôi, viết nhanh thì cũng viết theo bạn Ba3ba3. Và bạn nào muốn tập viết code thì cũng chưa nghĩ ra Dic, thú thật là cũng hơi cao.
    Đề nghị Bác NDU khi có chiêu nào mới thì nên viết dài một chút cho mọi người dễ hiểu và dễ test.
    Thú thật là mình chả thích vòng Do … loop và "On Error Resume Next" lắm.
    Collection Object
    Mới về xem bài này, rất lo lắng, đành phải viết bài chữ được chữ mất. Sợ rằng 2 bạn lại escape luôn thì lại …
    Nay lại biết thêm "Collection Object", tôi hưa rằng sẽ test thử. Cám ơn Ba3Ba3, nên bỏ bớt 1 số 3 là quá đã.
    Thú thật nhờ sự tranh cãi như vậy mà tôi nắm bắt thêm nhiều chiêu.
    Xin rằng 2 bạn vẫn vậy như bỏ qua mấy câu cảm thán nhé.
    Cám ơn 2 bạn rất nhiều. Mong rằng mình sẽ có nhiều bài từ 2 bạn. mình thấy Ba3Ba3 cũng là chuyên giá nhất là về array, mình đang mê món này lắm chỉ chưa đủ khả năng chứng tỏ là nó hay thế nào.
    Thứ lỗi giúp vì mình nói sai.

    Cám ơn NDU. Cám ơn Ba3ba3.

    Collection gần giống với Dictionary, nó được cái khỏi cần dùng CreateObject gì đó… nhưng nó cũng có cái dở, đó là:
    – Không có Exists method để xác định sự tồn tại, cuối cùng thì bạn vẫn phải On Error Resume Next đấy thôi —> rõ ràng bạn hiểu rất rõ lỗi có thể xãy ra nên mới dùng On Error… đúng không? —> Vậy cũng có khác gì bài số #1?
    – Gọi là Collection cũng đúng, nó chỉ làm nhiệm vụ "thu gom" vào 1 đóng lộn xộn (chẳng phải mảng) nên cuối cùng lại phải tốn thêm 1 vòng lập để duyệt qua các phần tử (Dictionary có Keys và Items đã là mảng rồi, cứ thế mà xài, khỏi thêm vòng lập)
    —————————————————-
    Phân tích để thấy được hết sự ưu việt của Dictionary trong bài toán này —> Tin chắc rằng dùng cách khác không thể tối ưu hơn được (chứ không phải nói là không thể dùng cách khác)

    Mình search thấy "New Collection" cũng gần giống "Scripting.Dictionary" nhưng chưa hiểu hết.
    Các phần "item, key, before, after" dùng thế nào.
    Nhờ NDU và Ba3ba3 cho 1 bài hướng dẫn cụ thể và có vd thì quá tốt. Mới mày mò được phần item và key.
    Cám ơn nhiều.

    Đã biết cách dùng Dictionary rồi thì Collection là tương tự… Có điều nó chỉ có thế này:
    1141
    "4 món ăn chơi" này xài y chang như Dictionary object thôi ThuNghi à
    Còn "before, after" gì gì đó, mình chưa hiểu lắm
    Ah… tôi hiểu cái vụ After, before rồi
    Nó giống như Add sheet ấy
    Nói nhiều không bằng ví dụ

    Sub Test()
    Dim i As Long, Col As New Collection
    Col.Add "A", "1"
    For i = 2 To 10
    Col.Add Chr(64 + i), CStr(i), 1
    Next
    For i = 1 To 10
    MsgBox Col.Item(i)
    Next
    End Sub

    Hy vọng bạn hiểu

    Mấu chốt là vậy. Cám ơn nhiều nhé.

    Col.Add Chr(64 + i), CStr(i), 1

    Hay

    Col.Add Chr(64 + i), CStr(i), ,1

    Ẹc… Ẹc…
    Nếu bạn thích Collection như thế thì "tặng" bạn hàm tôi tự viết

    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
    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ác ơi cho em hỏi, nếu em muốn tao ra một dãy số ngẫu nhiên đều hiện thị ở 4 chữ số thì làm sao hả bác
    vd : nó hiện thị ra các số ở dạng là 0003,0023…..
    bác cố giúp dùm em nha
    thanks

    Thì bạn cứ tạo số bình thường, sau khi xong việc, bạn quét chọn vùng dữ liệu, vào menu FormatCells … Trong tab Number, bạn chọn Custom rồi gõ vào khung Type ở bên phải 4 số 0 (0000) —> Vậy là xong!

  3. hands says:

    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é!

    Tuy chưa hiểu hết í bạn, nhưng bạn tham khảo hàm tự tạo sau:

    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

    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

    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.

    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

    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]kết quả lần chạy Macro thứ i của lần mở file thứ x giống kết quả lần chạy macro thứ i của lần mở file thứ y. Liệu Excel của em có bị bệnh không bác?

    Do sơ sót thôi!
    Sửa hàm UniqueRandomNum thành vầy:

    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

    Thêm thằng em [Randomize vào nữa, bảo đảm các lần chạy sẽ không bao giờ giống nhau

  4. hands says:

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

    http://www.giaiphapexcel.com/diendan/threads/t%E1%BA%A1o-d%C3%A3y-s%E1%BB%91-ng%E1%BA%ABu-nhi%C3%AAn-kh%C3%B4ng-tr%C3%B9ng.27286/post-728235

  5. hands says:

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

    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.

    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

    http://www.giaiphapexcel.com/diendan/threads/t%E1%BA%A1o-d%C3%A3y-s%E1%BB%91-ng%E1%BA%ABu-nhi%C3%AAn-kh%C3%B4ng-tr%C3%B9ng.27286/post-746159

    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é

    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

    hi [URL="https://www.giaiphapexcel.com/forum/member.php?189279-doveandrose"%5Ddoveandrose,

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

    (Mình gửi kèm theo file minh họa)

    Rất cảm ơn vì được hỗ trợ.

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

    http://www.giaiphapexcel.com/diendan/threads/t%E1%BA%A1o-d%C3%A3y-s%E1%BB%91-ng%E1%BA%ABu-nhi%C3%AAn-kh%C3%B4ng-tr%C3%B9ng.27286/post-746684

  6. hands says:

    làm thử bạn kiểm tra lại, để tiện cho bạn kiểm tra mình làm thêm sheet2

    Mình cũng có sử dụng nhưng vẫn không như ý của mình mong muốn. Cảm ơn bạn [URL="https://www.giaiphapexcel.com/forum/member.php?373036-HieuCD"%5DHieuCD đã hỗ trợ.

    à có khiếu nại thì ta tính tiếp . Bạn cho biết 1 cửa hàng nằm trên nhiều khu vực có thật không ? tôi thấy có vẻ vô lý . Bạn giải thích dùm tôi khúc này1146

    Khu vực ở đây chỉ là vị trí ngồi thôi bạn, không phải khu vực địa lý. Cửa hàng có nhiều khách thì ngồi ở nhiều khu vực ạ.

    Nếu 1 khu vực chứa nhiều cửa hàng và 1 cửa hàng cũng nằm trên nhiều khu vực thì đây là bài toán thật sự khó , hoặc có thể là tôi chưa nhìn ra chìa khóa giúp đơn giản hóa vấn đề . Bạn thử chạy file này xem sao

  7. hands says:

    Lần sau nên lập topic riêng, xen ngang bị xóa hết là ráng chịu đó nghe!

    Tuy chưa hiểu hết í bạn, nhưng bạn tham khảo hàm tự tạo sau:

    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

    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)

    Code trên có một điểm yếu mà rất dễ gây treo máy Until .Count = Amount

    Nếu Amount=99% * Top và top tương đối lớn thì nó chạy rất là chậm và không ổn định về mặt thời gian. Giả sử top=1000, và amount=999, hàm tìm được 998 giá trị. Khi tìm giá trị cuối cùng thì xác xuất thành công sẽ là (1000-998)/1000, khá nhỏ, nên dễ gây treo máy. Thử nghiệm top=500000 và amount=495000 có khi chạy mất 20s tới 40s.
    Với code dưới, nó chạy cực nhanh luôn mà không cần dùng dic hoặc collect.

    Function UniqueRandomNum2(Bottom As Long, Top As Long, Amount As Long)
    
    If Top - Bottom + 1 < Amount Or Amount <= 0 Then
            UniqueRandomNum2 = CVErr(xlErrNA)
            Exit Function
        End If
    
    Dim lTemp As Long
        Dim lNum As Long
        Dim lIndex As Long
        Dim lStart As Long
    
    Dim Ar() As Long
        Dim arKq() As Long
    
    lNum = Top - Bottom + 1
        ReDim Ar(1 To lNum) As Long
        ReDim arKq(1 To Amount, 1 To 1) As Long
    
    lStart = Bottom - 1
        For lTemp = 1 To Amount
            Do
                lIndex = 1 + Int(Rnd() * lNum)
            Loop While lNum < lIndex
    
    If Ar(lIndex) = 0 Then
                arKq(lTemp, 1) = lIndex + lStart
            Else
                arKq(lTemp, 1) = Ar(lIndex) + lStart
            End If
    
    If Ar(lNum) = 0 Then
                Ar(lIndex) = lNum
            Else
                Ar(lIndex) = Ar(lNum)
            End If
            lNum = lNum - 1
    
    Next
    
    UniqueRandomNum2 = arKq
    
    End Function

    chào mừng bạn đến châu Mỹ. Nhưng thật tiếc tác giả đề tài này đã cải tiến code rồi. Người ta dùng có 1 vòng lặp thôi bạn ạ.

    Dùng bao nhiêu vòng lặp mình nghĩ không quan trọng, thuật toán mới là thứ để nói, vòng lặp Do của mình viết ra cho nó có, chứ hầu như mỗi lần nó chỉ thực hiện duy nhất một lần thôi nhé. Mình cho nó vào để đề phòng những trường hợp do sai số tính toán mà có thể gây lôi.

    Mình thì chưa biết code mới như thế nào, nhưng nếu dùng dic thì chưa chắc nhanh đâu nhé, bởi code trên đều thao tác trên mảng.

    http://www.giaiphapexcel.com/diendan/threads/t%E1%BA%A1o-d%C3%A3y-s%E1%BB%91-ng%E1%BA%ABu-nhi%C3%AAn-kh%C3%B4ng-tr%C3%B9ng.27286/post-786629

  8. hands says:

    Dùng bao nhiêu vòng lặp mình nghĩ không quan trọng, thuật toán mới là thứ để nói, vòng lặp Do của mình viết ra cho nó có, chứ hầu như mỗi lần nó chỉ thực hiện duy nhất một lần thôi nhé. Mình cho nó vào để đề phòng những trường hợp do sai số tính toán mà có thể gây lôi.

    Mình thì chưa biết code mới như thế nào, nhưng nếu dùng dic thì chưa chắc nhanh đâu nhé, bởi code trên đều thao tác trên mảng.

    Đề 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

    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

    http://www.giaiphapexcel.com/diendan/threads/t%E1%BA%A1o-d%C3%A3y-s%E1%BB%91-ng%E1%BA%ABu-nhi%C3%AAn-kh%C3%B4ng-tr%C3%B9ng.27286/post-786633

  9. hands says:

    Dựa trên code của bạn, bỏ vài lệnh

    Function UniqueRandom(ByVal Bottom As Long, ByVal Top As Long, ByVal N As Long) As Variant
      Dim Arr() As Long, Darr() As Long, Tmp As Long, i As Long, k As Long, ik As Long
      If Top > Bottom Then
        If N > Top - Bottom + 1 Then N = Top - Bottom + 1
        ReDim Darr(Bottom To Top):      ReDim Arr(1 To N, 1 To 1)
        Randomize
        k = Top - Bottom + 1
        For i = 1 To N
          ik = k + Bottom - 1
          Tmp = Int(Rnd() * k) + Bottom
          If Darr(Tmp) = 0 Then Darr(Tmp) = Tmp
          Arr(i, 1) = Darr(Tmp)
          If Darr(ik) = 0 Then Darr(Tmp) = ik Else Darr(Tmp) = Darr(ik)
          k = k - 1
        Next i
        UniqueRandom = Arr
      End If
    End Function

    Sao mình ghét mấy cái Darr hay (Sarr) này ghê! Chẳng đúng chuẩn mực tên biến tí nào!
    Biết rằng việc đặt tên biến là tùy sở thích, code chạy chính xác vẫn quan trọng hơn. Tuy nhiên, nếu tất cả mọi người đều tuân thủ 1 nguyên tắc chung thì việc đọc code sẽ trở nên rất dễ dàng (liếc qua đã hiểu)
    Các bạn có tưởng tượng ngày nào đó chúng ta lập nhóm viết phần mềm rồi trưởng dự án giao cho mỗi người viết 1 module… Khi ấy mà mỗi người viết mỗi kiểu thì đố mà kiểm tra được đấy (được cũng mất rất nhiều thời gian)
    Trên mạng người ta kháo nhau rằng: 1 người Việt Nam có thể giỏi hơn 1 người Nhật hoặc Hàn Quốc nhưng 10 người Việt Nam cộng lại thì.. dở ẹc. Tôi tin rằng người ta đang muốn nói đến vấn đề làm việc nhóm
    Hãy tham khảo các trang lập trình nước ngoài (nhất là trang từ MS) hoặc đọc tài liệu về các hàm API, các bạn sẽ thấy người ta viết rất chuẩn mực (ngay từ khâu đặt tên biến)
    Với người mới tập tành VBA tôi không đề cập, riêng bạn hieuCD (và nhiều bạn khác) đã giỏi lắm rồi, cũng đến lúc các bạn nên chăm chút cho các phần mà tôi đề cập ở trên đi là vừa
    Nếu ý kiến cá nhân tôi có làm mích lòng ai đó thì xem như tôi chưa nói gì (tại thấy… ngứa miệng chút)

    Do quen thôi, mới đầu chép code của các bạn trên diễn đàn rồi viết theo, riết thành quen nhìn là biết tác dụng của các biến, cũng đổi cách đặt biến mấy lần nhưng cuối code nhìn không ra
    Viết code vui thôi, chỉ có mấy lệnh xào tới xào lui là hết vốn
    chúc bạn 1 tối vui

  10. hands says:

    Đề tài này có từ năm 2009, năm mình mới gia nhập diễn đàn, đọc xong code của thầy Ndu mình thấy ….một đống đom đóm trước mặt, ngứa miệng …hét
    Em đi RỪNG CHƯA THAY LÁ
    Đến bi giờ võ vẽ được tí code, đọc xong bài #97 của bạn Hiếu CD lại ngứa miệng….hét:
    Em về RỪNG LÁ CHƯA THAY
    Híc
    Bi giờ ( lại bi giờ) tui xin hỏi các thầy, các chú & các anh trong hội Người Cao Tuổi ở GPE viết bài này ( Tạo dãy số ngẫu nhiên không trùng) kiểu nào ( với điều kiện số lần lặp để lấy ngẫu nhiên ít nhất) để khỏi bị lỗi như bài #100, Ai viết được sẽ….có thưởng (Bác Sa, Ba Tê thì thưởng 1 xị "gụ", anh em khác thưởng tượng trưng 2 lon bia (tự chọn)
    Thân

    Nạp 1/2 xị nếp Long An, nắn lại gân cốt, thử sức xem sao

    Function UniqueRandom(ByVal Bottom As Long, ByVal Top As Long, ByVal N As Long) As Variant
      Dim Arr() As Long, Darr() As Variant, Tmp As Long, i As Long, k As Long
      If Top > Bottom Then
        If N > Top - Bottom + 1 Then N = Top - Bottom + 1
        ReDim Darr(1 To Top - Bottom + 1):  ReDim Arr(1 To N, 1 To 1)
        k = Top - Bottom + 1
        For i = 1 To N
          Tmp = Int(Rnd() * k) + 1
          If Darr(Tmp) = "" Then Darr(Tmp) = Tmp + Bottom - 1
          Arr(i, 1) = Darr(Tmp)
          If Darr(k) = "" Then Darr(Tmp) = k + Bottom - 1 Else Darr(Tmp) = Darr(k)
          k = k - 1
        Next i
        UniqueRandom = Arr
      End If
    End Function

    Nếu lỡ được thưởng, xin được phép chia cho anh chị trong hội người cao tuổi GPE :pimp:
    chúc các bạn một ngày vui/-*+//-*+//-*+/

    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)
    .resize(ubound(meData)).value = Application.Transform(meData)
    end sub

    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

    http://www.giaiphapexcel.com/diendan/threads/t%E1%BA%A1o-d%C3%A3y-s%E1%BB%91-ng%E1%BA%ABu-nhi%C3%AAn-kh%C3%B4ng-tr%C3%B9ng.27286/post-787259

  11. hands says:

    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
    .Resize(iHang) = Kq
    End Sub

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

    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.

    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.

    http://www.giaiphapexcel.com/diendan/threads/t%E1%BA%A1o-d%C3%A3y-s%E1%BB%91-ng%E1%BA%ABu-nhi%C3%AAn-kh%C3%B4ng-tr%C3%B9ng.27286/post-803642

  12. hands says:

    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

  13. hands says:

    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 http://www.giaiphapexcel.com/diendan/threads/tạo-dãy-số-ngẫu-nhiên-không-trùng.27286/

    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)

    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.

    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

    UniqueRandomNum = WorksheetFunction.Transpose(.Keys)
    UniqueRandomNum = .Keys

    http://www.giaiphapexcel.com/diendan/threads/t%E1%BA%A1o-d%C3%A3y-s%E1%BB%91-ng%E1%BA%ABu-nhi%C3%AAn-kh%C3%B4ng-tr%C3%B9ng.27286/post-934784

    Bạn thử.Chỉnh 1 chút không biết có đúng ý không.

    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
    =UniqueRandomNum(23,30,5,0)
    =UniqueRandomNum(23,30,5,1)

    http://www.giaiphapexcel.com/diendan/threads/t%E1%BA%A1o-d%C3%A3y-s%E1%BB%91-ng%E1%BA%ABu-nhi%C3%AAn-kh%C3%B4ng-tr%C3%B9ng.27286/post-934785

    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.

    Hi em sửa theo bài 1 thôi anh.

    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.

    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
  14. hands says:

    Đề 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

    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

    Dạ cháu dùng sự kiện open và call … thì kết quả không còn random ạ huhu

    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:

    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
  15. hands says:

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

    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

    Thử dùng hàm tự tạo

    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

    http://www.giaiphapexcel.com/diendan/threads/t%E1%BA%A1o-d%C3%A3y-s%E1%BB%91-ng%E1%BA%ABu-nhi%C3%AAn-kh%C3%B4ng-tr%C3%B9ng.27286/post-953127

  16. hands says:

    Thử dùng hàm tự tạo

    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

    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 đỡ ạ!

    Phải có danh sách các số bỏ đi, mới né nó được

    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

    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

    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

    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 ạ?

    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.
    @domjnjc
    Hàm xyz ở trên, bạn nhập thế nào

    http://www.giaiphapexcel.com/diendan/threads/t%E1%BA%A1o-d%C3%A3y-s%E1%BB%91-ng%E1%BA%ABu-nhi%C3%AAn-kh%C3%B4ng-tr%C3%B9ng.27286/post-1003271

    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?

    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
    1605917702

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

    Thử lại:

    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 ạ!

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

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

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

    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.

    http://www.giaiphapexcel.com/diendan/threads/t%E1%BA%A1o-d%C3%A3y-s%E1%BB%91-ng%E1%BA%ABu-nhi%C3%AAn-kh%C3%B4ng-tr%C3%B9ng.27286/post-1003324

  17. hands says:

    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

    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)

    http://www.giaiphapexcel.com/diendan/threads/t%E1%BA%A1o-d%C3%A3y-s%E1%BB%91-ng%E1%BA%ABu-nhi%C3%AAn-kh%C3%B4ng-tr%C3%B9ng.27286/post-1003350

  18. hands says:

    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:

    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!

    http://www.giaiphapexcel.com/diendan/threads/t%E1%BA%A1o-d%C3%A3y-s%E1%BB%91-ng%E1%BA%ABu-nhi%C3%AAn-kh%C3%B4ng-tr%C3%B9ng.27286/post-1003354

  19. hands says:

    Thử UDF này:

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

    =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

    =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

    =zzz(1,10,2,5)

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

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

    http://www.giaiphapexcel.com/diendan/threads/t%E1%BA%A1o-d%C3%A3y-s%E1%BB%91-ng%E1%BA%ABu-nhi%C3%AAn-kh%C3%B4ng-tr%C3%B9ng.27286/post-1003374

Leave a Reply

Your email address will not be published. Required fields are marked *

Quảng cáo

Cũ vẫn chất

Xem thêm