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 · 27/2/18

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 · 27/2/18

cuong003 đã viết:
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 · 27/2/18

giaiphap đã viết:
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 · 27/2/18

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 · 27/2/18

cuong003 đã viết:
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.

Mã:

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 · 27/2/18

giaiphap đã viết:

Dùng thử code này.

Mã:

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 · 27/2/18

giaiphap đã viết:

Dùng thử code này.

Mã:

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 · 27/2/18

giaiphap đã viết:

Dùng thử code này.

Mã:

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 · 27/2/18

cuong003 đã viết:
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 · 27/2/18

VetMini đã viết:
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 · 27/2/18

VetMini đã viết:
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 · 27/2/18

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 · 27/2/18

cuong003 đã viết:
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 · 27/2/18

phuocam đã viế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.

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 · 27/2/18

cuong003 đã viết:
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 · 27/2/18

phuocam đã viết:
Đâ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 · 27/2/18

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 · 27/2/18

phuocam đã viế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.

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.

cuong003 đã viết:
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 · 27/2/18

VetMini đã viết:
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 · 27/2/18

VetMini đã viết:
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 đỡ!

Ba Tê · 27/2/18

cuong003 đã viết:
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.

Viết cho bạn 1 Macro, bạn sử dụng cách nào thì tùy nhé, tôi không dám tạo 1 add-in.

PHP:

Public Sub GPE()
Dim Ws As Worksheet, sArr(), dArr(), I As Long, K As Long, R As Long
For Each Ws In ThisWorkbook.Worksheets
    With Ws
        sArr = .Range("A5", .Range("B5").End(xlDown)).Value
        R = UBound(sArr)
        ReDim dArr(1 To 10, 1 To 2)
        K = 0
        Randomize
            Do
                I = Int(Rnd * R) + 1
                If sArr(I, 1) > 0 Then
                    K = K + 1
                    dArr(K, 1) = sArr(I, 1)
                    dArr(K, 2) = sArr(I, 2)
                    sArr(I, 1) = 0
                End If
                If K = 10 Then Exit Do
            Loop
        .Range("D5").Resize(10, 2) = dArr
        .Range("D5").Resize(10, 2).Sort Key1:=.Range("D5"), Order1:=xlAscending
    End With
Next Ws
End Sub

VetMini · 27/2/18

Ba Tê đã viết:
Viết cho bạn 1 Macro, bạn sử dụng cách nào thì tùy nhé, tôi không dám tạo 1 add-in.

PHP:

'...' For Each Ws In ThisWorkbook.Worksheets With Ws sArr = .Range("A5", .Range("B5").End(xlDown)).Value R = UBound(sArr) ReDim dArr(1 To 10, 1 To 2) K = 0 Randomize '...' Next Ws End Sub

Chỉ cần Randomize 1 lần thôi. Đặt nó trước vòng lặp. Randomize bên trong vòng lặp có khi tạo ra kết quả bất ngờ: nếu code chạy nhanh quá, có thể gây ra hiệu ứng số ngẫu nhiên bị lặp lại.

AutoReply đã viết:
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 đỡ!

Trường lớn cỡ này thì bảo Sinh Viên chúng tự làm lấy quy trình trực.

"đc hay hơn ko" là gì? Đặc hay hơn co?

cuong003 · 27/2/18

VetMini đã viết:
Chỉ cần Randomize 1 lần thôi. Đặt nó trước vòng lặp. Randomize bên trong vòng lặp có khi tạo ra kết quả bất ngờ: nếu code chạy nhanh quá, có thể gây ra hiệu ứng số ngẫu nhiên bị lặp lại.

Trường lớn cỡ này thì bảo Sinh Viên chúng tự làm lấy quy trình trực.

"đc hay hơn ko" là gì? Đặc hay hơn co?

Bác bắt bẻ em ghê quá @@. Chả biết lúc đó trong đầu nghĩ ngì nữa
Cảm ơn bác đã ghé thăm ^^

cuong003 · 27/2/18

Ba Tê đã viết:

Viết cho bạn 1 Macro, bạn sử dụng cách nào thì tùy nhé, tôi không dám tạo 1 add-in.

PHP:

Public Sub GPE()
Dim Ws As Worksheet, sArr(), dArr(), I As Long, K As Long, R As Long
For Each Ws In ThisWorkbook.Worksheets
    With Ws
        sArr = .Range("A5", .Range("B5").End(xlDown)).Value
        R = UBound(sArr)
        ReDim dArr(1 To 10, 1 To 2)
        K = 0
        Randomize
            Do
                I = Int(Rnd * R) + 1
                If sArr(I, 1) > 0 Then
                    K = K + 1
                    dArr(K, 1) = sArr(I, 1)
                    dArr(K, 2) = sArr(I, 2)
                    sArr(I, 1) = 0
                End If
                If K = 10 Then Exit Do
            Loop
        .Range("D5").Resize(10, 2) = dArr
        .Range("D5").Resize(10, 2).Sort Key1:=.Range("D5"), Order1:=xlAscending
    End With
Next Ws
End Sub

Cảm ơn bác đã giúp đỡ ! Em chỉ có mong muốn như vậy thôi ^^. Bác bonus cho em thêm dòng sắp lại danh sách theo số thứ tự em rất toai nguyện ko còn mong muốn j hơn nữa ^^
Một lần nữa xin cảm ơn các bạn đã giúp đỡ!

AutoReply · 27/2/18

VetMini đã viết:
Chỉ cần Randomize 1 lần thôi. Đặt nó trước vòng lặp. Randomize bên trong vòng lặp có khi tạo ra kết quả bất ngờ: nếu code chạy nhanh quá, có thể gây ra hiệu ứng số ngẫu nhiên bị lặp lại.

Trường lớn cỡ này thì bảo Sinh Viên chúng tự làm lấy quy trình trực.

"đc hay hơn ko" là gì? Đặc hay hơn co?

em cũng chưa rõ là gì ạ. Sao chép ỡ chỗ khác mà. -+*/

VetMini · 27/2/18

AutoReply đã viết:
em cũng chưa rõ là gì ạ. Sao chép ỡ chỗ khác mà.

Tôi biết là sao chép. Nhưng tôi không hỏi chỗ gốc vì lý do cá nhân.

Cũng như phần dưới đây tôi chỉ nói riêng với người viết code bài #21:
Code ấy chỉ áp dụng được 1 lần. Nếu chạy lần thứ nhì, code cần xét thêm phần đã lấy ra trong các lần trước. Chạy càng nhiều lần, xác suất chạm càng nhiều, và trên lý thuyết có thể chạy cả giờ.
Khi phải chạy nhiều lần thì cách dễ nhất là dùng cột phụ để chứa số ngẫu nhiên và sort.
1. copy dữ liệu ra bảng khác
2. đặt số ngẫu nhiên ở cột phụ
3. sắp xếp
4. lấy ra 10 dòng đầu
5. đánh dấu những dòng đã lấy ra (điển hình bằng cách đổi số ở cột phụ thành số âm)
6. lần kế tiếp chỉ việc lặp lại bước 4 (bắt đầu từ số dương)

Nếu có sự thêm ngừoi vào danh sách thì đặt số ngẫu nhiên cho các dòng mới đó. Và lặp lại bước 3 (bắt đầu từ số dương)

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)

Người dùng đang xem chủ đề này

Thành viên mới

File đính kèm

==(^o^)==

Thành viên mới

Đang đi tìm hòn đá

==(^o^)==

Thành viên mới

Đang đi tìm hòn đá

Thành viên mới

Đang đi tìm hòn đá

Thành viên mới

Thành viên mới

Thành viên mới

Thành viên mới

Thành viên mới

Thành viên mới

Thành viên mới

Thành viên mới

Đang đi tìm hòn đá

Thành viên mới

Thành viên tiêu biểu

Cạo Rồi Khỏi Gội

Đang đi tìm hòn đá

Thành viên mới

Thành viên mới

Thành viên tiêu biểu

Đang đi tìm hòn đá

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