Lớp học GPE tháng 10 - TPHCM: Conditional Formatting và Data Validation (tối 4, 6/10) | Excel cơ bản (tối 9, 11, 13/10) |
Thuần thục các hàm dò tìm (tối 10, 12/10) | Tất tần tật về PivotTable (tối 16, 18, 20/10) |
Tất tần tật về Filter và Advanced Filter (tối 23, 25/10) | Name động và biểu đồ (tối 24, 26, 28/10)

Đăng ký học Khởi đầu cùng Google Spreadsheet - 2 chủ nhật 1 và 8/10 - TPHCM

Đăng ký học Xây dựng ứng dụng Form bằng VBA - 2 chủ nhật 15 và 22/10 - TPHCM

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

Thảo luận trong 'Lập Trình với Excel' bắt đầu bởi anhtuan1066, 7 Tháng chín 2009.

  1. anhtuan1066

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

    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 LongTop As LongAmount 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ớnbao 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(110030)
    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)
     

    Các file đính kèm:

    Lần chỉnh sửa cuối: 7 Tháng chín 2009
  2. anhtuan1066

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

    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
     

    Các file đính kèm:

  3. asialhu

    asialhu Thành viên mới

    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.

     
  4. ndu96081631

    ndu96081631 Ăn cùng GPE, Ở cùng GPE, Sống cùng GPE Staff Member Super Moderator

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

    PhanTuHuong Excel & AutoCad & VBA

    Hàm của bác Tuấn lạ ghê mà độc đáo nữa.
     
  6. vkk77

    vkk77 Thành viên mới

    Lọc danh sách

    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
     
    Lần chỉnh sửa cuối: 19 Tháng một 2010
  7. ba3ba3

    ba3ba3 Thành viên mới

    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)
    Mã:
    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
     
  8. ndu96081631

    ndu96081631 Ăn cùng GPE, Ở cùng GPE, Sống cùng GPE Staff Member Super Moderator

    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 = ? )
     
    Lần chỉnh sửa cuối: 15 Tháng mười 2010
  9. ba3ba3

    ba3ba3 Thành viên mới

    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:
    Mã:
    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 ý
     
  10. ndu96081631

    ndu96081631 Ăn cùng GPE, Ở cùng GPE, Sống cùng GPE Staff Member Super Moderator

    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 LongTop As LongAmount 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(Tmpthen .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
     
  11. ThuNghi

    ThuNghi Hãy cho rồi sẽ nhận!

    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.
    Cám ơn NDU. Cám ơn Ba3ba3.
     
  12. ba3ba3

    ba3ba3 Thành viên mới

    * Rảnh rỗi xem các bài viết trên forum GPE cũng thú vị. Thật ra tôi không phải là coder chuyên nghiệp, tôi chỉ tò mò ột số bài viết "vừa tầm hiểu biết chừng mực của mình". Tôi tham gia thảo luận không phải với tinh thần hơn - thua mà cốt yếu là trao đổi học thuật.

    * Tôi khẳng định: Function UniqueRandomNum của tác giả anhtuan1066 là rất hay: ngắn gọn, chạy tốt.
    Tôi chỉ không đồng ý với tác giả nhận định: các coder viết về vấn đề nầy "...đều viết rất khó hiểu và dài dòng!"

    *
    Tôi biết bạn ndu96081631 là coder giỏi, tham gia BQT GPE, ngoài đời bạn có thể là giáo viên, giảng viên; tuy nhiên khi viết code, có thể như nhiều người, bạn có thể quên dùng điều gì đó. Do vậy bài viết của tôi hay người khác có thể nhắc bạn lại những điều ấy..., ngoài ra không dám chỉ bảo để bạn nói "mỉa mai" như trên.

    -> với error resume next, bạn đã viết If Not .Exists(Tmp) then .Add Tmp, ""
    đã chứng tỏ điều trên, và do vậy, code đẹp hơn nhiều.

    -> do chú trọng code ngắn, khi dùng hàm Rnd() bạn đã quên dùng hàm Randomize hổ trợ, thành ra kết quả chưa tối ưu.

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

    Mã:
     
    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
     
    
    --------
    Cảm ơn bạn ThuNghi đã động viên
     
    Lần chỉnh sửa cuối: 15 Tháng mười 2010
  13. ThuNghi

    ThuNghi Hãy cho rồi sẽ nhận!

    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.


     
  14. HYen17

    HYen17 Thành viên cằn cỗi.

    Đã từ lâu, giờ thấy lại collection

    Từ khi GPE chưa sinh ra mình đã thấy đâu đó Collection Object; Nhưng thú thật chưa hiểu mấy & cố tình ứng dụng vô các công việc nhưng không xong; Sau đó bỏ lững,. . . . (Quả thật cũng có dị ứng với biến đối tượng do cảm giác chúng chiếm dụng nhiều tài nguyên đang lúc nào cũng hạn hẹp của mình,. . .)

    Hôm nay thấy lại từ này, nên sẽ dành thêm thời gian rỗi ngâm cứu về nó & rất mong được sự trợ giúp từ cộng đồng.

    Xin cảm ơn các bạn đã nêu vấn đề. Nhưng theo mình các bạn nào đang chập chững vô VBA thì chớ nhào vô những cái ni, nếu thời gian không thật sự rỗi rãnh.

    Khà, khà,. . . .
     
  15. ndu96081631

    ndu96081631 Ăn cùng GPE, Ở cùng GPE, Sống cùng GPE Staff Member Super Moderator

    Cảm ơn những góp ý của bạn... Nhưng mà, tôi nói thật lòng, bạn lại cho rằng tôi mỉa mai (biển học vô bờ, nào ai dám chê ai...)

    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)
     
    Lần chỉnh sửa cuối: 16 Tháng mười 2010
  16. ThuNghi

    ThuNghi Hãy cho rồi sẽ nhận!

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

    ndu96081631 Ăn cùng GPE, Ở cùng GPE, Sống cùng GPE Staff Member Super Moderator

    Đã biết cách dùng Dictionary rồi thì Collection là tương tự... Có điều nó chỉ có thế này:

    untitled.JPG

    "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
     
  18. ndu96081631

    ndu96081631 Ăn cùng GPE, Ở cùng GPE, Sống cùng GPE Staff Member Super Moderator

    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ụ
    PHP:
    Sub Test()
      
    Dim i As LongCol As New Collection
      Col
    .Add "A""1"
      
    For 2 To 10
       Col
    .Add Chr(64 i), CStr(i), 1
      Next
      
    For 1 To 10
        MsgBox Col
    .Item(i)
      
    Next
    End Sub
    Hy vọng bạn hiểu
     
  19. ThuNghi

    ThuNghi Hãy cho rồi sẽ nhận!

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

    ba3ba3 Thành viên mới

    Collection Object

    Collection.Add Item=Any, Key=String, Before, After. Nê'u Add theo thứ tự thì Ðể trô'ng

    * Before và After, nếu dùng số thì đấy là số phần tử theo thứ tự của Collection. Chúng ta coi chừng nhầm lẫn ở đây.
    vd Col = 1,2,3,4,5,6,7,8,9
    Col.Add 50,"aa",3 -> 1,2,50,3,4,5,6,7,8,9
    tiếp Col.Add "GGG","zz", ,7 -> 1,2,50,3,4,5,6,GGG,7,8,9
    ở trên ta ngỡ sau số 7 => (1,2,50,3,4,5,6,7,GGG,8,9). Bạn nên lưu ý

    Muốn chính xác, nên dùng text, trường hợp Add lần 2 sau số 7, ta viết:
    Col.Add "GGG","zz", ,"7"

    Bạn thử xem hàm dùng Collection sau, đương nhiên sẽ chậm thua Function UniqueRandomNum, code nầy chỉ minh họa để các bạn thêm cách sử dụng Collection. Code hoàn toàn không bẫy lỗi:
    Mã:
     
     Sub Test5()
        Range("E1:E25").Value = MangNNkLL(99, 75, 25)
     End Sub
     
     Function MangNNkLL(ByVal Cao As Long, ByVal Thap As Long, _
            ByVal SoL As Long) 'code: ba3ba3 thân tang các ban 10/2010
     
        'Nêu sô' luong yêu câu > Cao-Thâ'p+1 thì lây Cao-Thâ'p+1
        If SoL > (Cao - Thap + 1) Then SoL = Cao - Thap + 1
        ' Khai báo các biê'n, Col là Object nên có "New"
        Dim Col As New Collection, i As Long, j As Long, SoRa As Long
        ' Vòng lap Ðô vào Col các sô trong gio'i han Ðã khai
        For i = Thap To Cao
            'Collection.Add Item=Any, Key=String, Before, After. Nê'u Add theo
            'thu' tu' thì Ðê trô'ng
            Col.Add i, CStr(i)
        Next
        ' Khai báo mang Ðông
        ReDim Mang(SoL - 1) As Long
        ' Hàm ngâu nhiên, moi lúc không giông nhau
        Randomize
        ' Vòng lap Ðô vào mang
        Do While j < SoL
            ' SoRa là sô ngau nhiên bât ky trong gioi han cua Col.Count
            ' Luu ý là Col.Count se thay Ðôi = nho dân dân cho Ðên 0
            SoRa = Int(Rnd * Col.Count + 1)
            ' Mang theo thu tu nhân sô bât ky tu' Col
            Mang(j) = Col(SoRa)
            ' và Col lâp tu'c lây sô Ðó ra
            Col.Remove (SoRa)
            ' Tang sô j Ðê goi phân tu Mang khác
            j = j + 1
        Loop
        MangNNkLL = WorksheetFunction.Transpose(Mang)
    End Function
    
     
    Lần chỉnh sửa cuối: 16 Tháng mười 2010

Chia sẻ trang này