Xin VBA chọn ngẫu nhiên 10 số bất kỳ không trùng nhau trong list có sẵn (1 người xem)

[cuong003]

Kính chào GPE!
Em có 1 bài toán mà không biết phải làm thế nào.
Có 1 file excel như đính kèm, trong file đó có khoảng 100 sheet mỗi sheet tên khác nhau nhưng kết cấu giống nhau và số lượng mẫu lại khác nhau.
Vậy phải làm thế nào để trong mỗi sheet chọn được ra 10 người bất kỳ không trùng nhau theo số thứ tự trong danh sách như ở sheet "DS1".
Kính mong nhận được sự giúp đỡ của cộng đồng GPE!

 

[giaiphap]

Kính chào GPE!
Em có 1 bài toán mà không biết phải làm thế nào.
Có 1 file excel như đính kèm, trong file đó có khoảng 100 sheet mỗi sheet tên khác nhau nhưng kết cấu giống nhau và số lượng mẫu lại khác nhau.
Vậy phải làm thế nào để trong mỗi sheet chọn được ra 10 người bất kỳ không trùng nhau theo số thứ tự trong danh sách như ở sheet "DS1".
Kính mong nhận được sự giúp đỡ của cộng đồng GPE!

Bạn tham khảo cái này.
http://www.giaiphapexcel.com/diendan/threads/tạo-dãy-số-ngẫu-nhiên-không-trùng.27286/

 

[cuong003]

Bạn tham khảo cái này.
http://www.giaiphapexcel.com/diendan/threads/tạo-dãy-số-ngẫu-nhiên-không-trùng.27286/

Cảm ơn bạn!
Mình cũng đã tham khảo và chọn được trên 1 sheet hiện hành rồi. Nhưng vấn đề là mình có 100 sheet mà phải vào từng sheet chạy macro thì rất vất vả. Có cách nào chạy tất cả các sheet trong file ko bạn?

 

[VetMini]

Nhờ chỉ dẫn cách làm hay nhờ từ a đến z?

Cách làm tay:
- Đặt một cột phụ = Rand()
- Nếu muốn thì Copy, paste value để cho định chắc số, không thay dổi
- Sort theo cột này
- Lấy 10 cái đầu

Cách làm code VBA:
- Viết một hàm lấy số n ngẫu nhiên từ 1 đến k. Hàm nhận tham số là n, k và trả về một mảng n số (nếu n là số nhỏ thì chuỗi csv cũng được). Dạng hàm là
Function SoNgauNhien(byval n as integer, byval k as integer) as Variant
- Viết một vòng lặp đi qua các sheets, đọc số dòng của mỗi sheet và gọi hàm trên
For each sh in worksheets
muoiSoChon = SoNgauNhien(10, hàm tính số dòng trong sheet ở đây)
dongChonThuNhat = muoiSoChon(1)
...
Next sh

 

[giaiphap]

Cảm ơn bạn!
Mình cũng đã tham khảo và chọn được trên 1 sheet hiện hành rồi. Nhưng vấn đề là mình có 100 sheet mà phải vào từng sheet chạy macro thì rất vất vả. Có cách nào chạy tất cả các sheet trong file ko bạn?

Dùng thử code này.

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
Sub Test()
    Dim Arr, sArr, dArr(1 To 10, 1 To 2), n As Long, Sh As Worksheet
    For Each Sh In ThisWorkbook.Worksheets
        With Sh
            Arr = .Range("A5:B" & .Range("A65000").End(xlUp).Row).Value
            n = .Range("A65000").End(xlUp).Value
            sArr = UniqueRandomNum(1, n, 10)
            For n = LBound(sArr, 1) To UBound(sArr, 1)
                dArr(n, 1) = sArr(n, 1)
                dArr(n, 2) = Arr(sArr(n, 1), 2)
            Next n
            .Range("D5:E14").Value = dArr
        End With
    Next Sh
End Sub

 

[cuong003]

Dùng thử code này.

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
Sub Test()
    Dim Arr, sArr, dArr(1 To 10, 1 To 2), n As Long, Sh As Worksheet
    For Each Sh In ThisWorkbook.Worksheets
        With Sh
            Arr = .Range("A5:B" & .Range("A65000").End(xlUp).Row).Value
            n = .Range("A65000").End(xlUp).Value
            sArr = UniqueRandomNum(1, n, 10)
            For n = LBound(sArr, 1) To UBound(sArr, 1)
                dArr(n, 1) = sArr(n, 1)
                dArr(n, 2) = Arr(sArr(n, 1), 2)
            Next n
            .Range("D5:E14").Value = dArr
        End With
    Next Sh
End Sub

cảm ơn bạn nhé! Chạy ngon rồi ^^

 

[VetMini]

Dùng thử code này.

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

Với dạng đơn giản này, bạn không cần phải bẫy lỗi.
Do
.Item( Int(Rnd() * (Top - Bottom + 1)) + Bottom) = ""
Loop Until .Count = Amount

Nếu key đã có rồi thì code trên chỉ sửa value
Nếu key chưa có thì nó tự động add vào

Chú: hình như chủ thớt quên chưa cho biết mình cần ngẫu nhiên thực hay ngẫu nhiên mặc định.
Ngẫu nhiên mặc định cho ra kết quả in hệt nhau mỗi lần chạy
Ngẫu nhiên thực cho ra kết quả khác nhau mỗi lần chạy.

 

[cuong003]

Dùng thử code này.

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
Sub Test()
    Dim Arr, sArr, dArr(1 To 10, 1 To 2), n As Long, Sh As Worksheet
    For Each Sh In ThisWorkbook.Worksheets
        With Sh
            Arr = .Range("A5:B" & .Range("A65000").End(xlUp).Row).Value
            n = .Range("A65000").End(xlUp).Value
            sArr = UniqueRandomNum(1, n, 10)
            For n = LBound(sArr, 1) To UBound(sArr, 1)
                dArr(n, 1) = sArr(n, 1)
                dArr(n, 2) = Arr(sArr(n, 1), 2)
            Next n
            .Range("D5:E14").Value = dArr
        End With
    Next Sh
End Sub

Có cách nào viết lại cho cái "Function UniqueRandomNum" vào trong macro "Test" không hả bạn?

 

[VetMini]

Có cách nào viết lại cho cái "Function UniqueRandomNum" vào trong macro "Test" không hả bạn?

Cho biết lý do?

(nếu bạn nêu được lý do chỉ muốn dựng cái dictionary 1 lần thay vì 100 lần thì trình độ bạn có thể tự sửa code rồi)

 

[cuong003]

Cho biết lý do?

(nếu bạn nêu được lý do chỉ muốn dựng cái dictionary 1 lần thay vì 100 lần thì trình độ bạn có thể tự sửa code rồi)

ah ^^, tại mình có nhiều file.
Ý tưởng của mình là bật 1 file chứa macro chọn như trên. Sau đó bật các file cần chọn rồi ấn phím tắt chạy macro để chọn. Nhưng do Function chỉ có trên file chứa macro ban đầu nên bật file khác lên nó chạy macro không có funtion nên ko ra kết quả.
Mình làm phục vụ công việc thui chứ không phải lô đề cờ bạc đâu @@

 

[cuong003]

Với dạng đơn giản này, bạn không cần phải bẫy lỗi.
Do
.Item( Int(Rnd() * (Top - Bottom + 1)) + Bottom) = ""
Loop Until .Count = Amount

Nếu key đã có rồi thì code trên chỉ sửa value
Nếu key chưa có thì nó tự động add vào

Chú: hình như chủ thớt quên chưa cho biết mình cần ngẫu nhiên thực hay ngẫu nhiên mặc định.
Ngẫu nhiên mặc định cho ra kết quả in hệt nhau mỗi lần chạy
Ngẫu nhiên thực cho ra kết quả khác nhau mỗi lần chạy.

Mình cần ngẫu nhiên thực bạn nhé. Đây thực chất là chọn mẫu trong tổng thể mẫu.

 

[cuong003]

Vì 1 trường có nhiều khóa, mỗi khóa có nhiều lớp và lưu trên 1 file. Mình muốn chọn ngẫu nhiên mỗi lớp 10 HS đi trực nhật ^^

 

[Phuocam]

Vì 1 trường có nhiều khóa, mỗi khóa có nhiều lớp và lưu trên 1 file. Mình muốn chọn ngẫu nhiên mỗi lớp 10 HS đi trực nhật ^^

Ngẫu nhiên kiểu này, sinh viên A trực tuần này rồi, tuần tới có cơ hội trực tiếp.

 

[cuong003]

Ngẫu nhiên kiểu này, sinh viên A trực tuần này rồi, tuần tới có cơ hội trực tiếp.

uh nhỉ. Nhưng chắc tỷ lệ này ít khả năng xảy ra ^^. Cảm ơn bạn nhé hehe. Mà có dính thì bảo do số nó đen, cái này do máy chọn chứ thầy chon đâu ^^

 

[Phuocam]

uh nhỉ. Nhưng chắc tỷ lệ này ít khả năng xảy ra ^^. Cảm ơn bạn nhé hehe. Mà có dính thì bảo do số nó đen, cái này do máy chọn chứ thầy chon đâu ^^

Đâu có được, phải loại sinh viên đã trực ra khỏi danh sách được chọn!

 

[cuong003]

Đâu có được, phải loại sinh viên đã trực ra khỏi danh sách được chọn!

Bạn viết hộ mình code đó nhé.
Các bạn khác ghé qua xin giúp mình nhé!
Cảm ơn các bạn nhiều!

 

[Phuocam]

Tôi nghĩ phải dùng thêm một cột để theo dõi số lần trực của sinh viên.

Ví dụ lớp có 37 SV , lần trực thứ 4 phải lấy được 7 SV chưa trực + 3 SV đã trực, như vậy mới công bằng.

 

[VetMini]

Ngẫu nhiên kiểu này, sinh viên A trực tuần này rồi, tuần tới có cơ hội trực tiếp.

Vì code không có randomize cho nên lần chạy tới sẽ bốc đúng bao nhiêu ấy số. Tức là chắc chắn chứ không phải chỉ có cơ hội.

ah ^^, tại mình có nhiều file.
Ý tưởng của mình là bật 1 file chứa macro chọn như trên. Sau đó bật các file cần chọn rồi ấn phím tắt chạy macro để chọn. Nhưng do Function chỉ có trên file chứa macro ban đầu nên bật file khác lên nó chạy macro không có funtion nên ko ra kết quả.
Mình làm phục vụ công việc thui chứ không phải lô đề cờ bạc đâu @@

Lúc đầu bạn nói có 100 sheets. Bây giờ là có nhiều files.
Cần thống nhất dữ kiện trước khi hỏi giải pháp.

 

[cuong003]

Vì code không có randomize cho nên lần chạy tới sẽ bốc đúng bao nhiêu ấy số. Tức là chắc chắn chứ không phải chỉ có cơ hội.



Lúc đầu bạn nói có 100 sheets. Bây giờ là có nhiều files.
Cần thống nhất dữ kiện trước khi hỏi giải pháp.

Mong muốn của mình là nhờ các bạn viết cho 1 macro để mình cho vào 1 file gốc như 1 add-in ấy. Lúc cần sử dụng thì mình bật các file cần chọn mẫu lên chọn thôi.
Bạn giaiphap đã viết hộ mình đoạn code đó và mình test thì chạy ngon trên file gốc. Nhưng do khai báo funtion chỉ có trên file đó nên chạy macro ở các file khác nó không thực hiện đc funtion kia do đó không ra được kết quả.
Mặt khác mình ko muốn lưu macro vào các file kết quả nên mới làm như vậy.
Vậy phải sửa code thế nào để có thể chạy đc trên nhiều file hả bạn ?
Mong muốn là như vậy không biết có cách nào làm đc hay hơn ko? Nếu có mong các bạn giúp đỡ!

 

[AutoReply]

Vì code không có randomize cho nên lần chạy tới sẽ bốc đúng bao nhiêu ấy số. Tức là chắc chắn chứ không phải chỉ có cơ hội.



Lúc đầu bạn nói có 100 sheets. Bây giờ là có nhiều files.
Cần thống nhất dữ kiện trước khi hỏi giải pháp.

Dạ em có nhiều files, mỗi file có 100 sheets. Mong muốn là như vậy không biết có cách nào làm đc hay hơn ko? Nếu có mong các bạn giúp đỡ!