Chọn 10 cái tên ngẫu nhiên trong danh sách 20 tên

Liên hệ QC
M

Manhcuong1236985

Thành viên mới
Tham gia
23/1/19
Bài viết
11
Được thích
1
Chào các anh chị. Cho em hỏi bài toán như sau
Cho 1 danh sách gồm 20 cái tên khác nhau, yêu cầu nhấc ra 1 tổ hợp gồm 10 tên ngẫu nhiên trong danh sách 20 tên đó, sao cho không có cái tên nào trong cùng 1 tổ hợp bị trùng nhau. Kết quả nằm trong 1 cell và các tên ngăn nhau bằng dấu trừ.
Nhờ anh chị cho em xin công thức ạ. Em xin cảm ơn nhiều!
Ảnh chụp Màn hình 2019-01-23 lúc 14.59.17.png
 
=RANDBETWEEN(A1,A2) &"-"& RANDBETWEEN(A3,A4)&"-"& RANDBETWEEN(A5,A6)&"-"& RANDBETWEEN(A7,A8)&"-"& RANDBETWEEN(A9,A10)&.....
Đơn giản quá nhỉ :D
 
Manhcuong1236985 đã viết:
Chào các anh chị. Cho em hỏi bài toán như sau
Cho 1 danh sách gồm 20 cái tên khác nhau, yêu cầu nhấc ra 1 tổ hợp gồm 10 tên ngẫu nhiên trong danh sách 20 tên đó, sao cho không có cái tên nào trong cùng 1 tổ hợp bị trùng nhau. Kết quả nằm trong 1 cell và các tên ngăn nhau bằng dấu trừ.
Nhờ anh chị cho em xin công thức ạ. Em xin cảm ơn nhiều!
View attachment 211501
Nhấp chuột vào đây để mở rộng...
Bạn thử code này:
Mã: 
Sub a()
Dim arr, num As Long, key, str As String
arr = [A1:A20]
With CreateObject("Scripting.dictionary")
    Do While .Count < 10
Randomize
        num = Int(Rnd() * 20) + 1
        If Not .exists(num) Then .Add num, arr(num, 1)
    Loop
        str = Join(.items(), " - ")
End With
[c1].Value = str
End Sub
 
Lần chỉnh sửa cuối:
Manhcuong1236985 đã viết:
Chào các anh chị. Cho em hỏi bài toán như sau
Cho 1 danh sách gồm 20 cái tên khác nhau, yêu cầu nhấc ra 1 tổ hợp gồm 10 tên ngẫu nhiên trong danh sách 20 tên đó, sao cho không có cái tên nào trong cùng 1 tổ hợp bị trùng nhau. Kết quả nằm trong 1 cell và các tên ngăn nhau bằng dấu trừ.
Nhờ anh chị cho em xin công thức ạ. Em xin cảm ơn nhiều!
View attachment 211501
Nhấp chuột vào đây để mở rộng...
Nếu không nối chuỗi có thể dùng công thức này:
=INDEX($A$1:$A$20,SMALL(IF(COUNTIF($E$1:E1,$A$1:$A$20)=0,ROW($1:$20)),RANDBETWEEN(1,21-COLUMN(A1))))
Bấm Ctrl+Shift+Enter rồi kéo sang phải.
 

File đính kèm

  • ex1.xlsb
    16.1 KB · Đọc: 25
excel_lv1.5 đã viết:
Bạn thử code này:
Mã: 
Sub a()
Dim arr, num As Long, key, str As String
arr = [A1:A20]
With CreateObject("Scripting.dictionary")
    Do While .Count < 10
Randomize
        num = Int(Rnd() * 20) + 1
        If Not .exists(num) Then .Add num, ""
    Loop
    For Each key In .keys()
        str = str & IIf(str = "", "", " - ") & arr(key, 1)
    Next
End With
[c1].Value = str
End Sub
Nhấp chuột vào đây để mở rộng...
Thử dùng Join cho đẹp
 
Manhcuong1236985 đã viết:
Chào các anh chị. Cho em hỏi bài toán như sau
Cho 1 danh sách gồm 20 cái tên khác nhau, yêu cầu nhấc ra 1 tổ hợp gồm 10 tên ngẫu nhiên trong danh sách 20 tên đó, sao cho không có cái tên nào trong cùng 1 tổ hợp bị trùng nhau. Kết quả nằm trong 1 cell và các tên ngăn nhau bằng dấu trừ.
Nhờ anh chị cho em xin công thức ạ. Em xin cảm ơn nhiều!
View attachment 211501
Nhấp chuột vào đây để mở rộng...
Dùng hàm tự tạo
Mã: 
Function GPE(ByVal Rng As Range, ByVal n As Long)
  Dim Str As String, tmp As String, m As Long, i As Long, j As Long
  m = Rng.Rows.Count
  Str = "- " & Join(Application.Transpose(Rng), " - ") & " -"
  Randomize
  For i = 1 To m - n
    num = Int(Rnd() * (m + 1 - i)) + 1
    tmp = Replace(Str, "-", "#", 1, num)
    j = InStrRev(tmp, "#")
    Str = Replace(Str, Mid(tmp, j + 1, InStr(1, tmp, "-") - j), "")
  Next i
  GPE = Mid(Str, 3, Len(Str) - 4)
End Function
 

File đính kèm

  • ex1.xlsb
    14.2 KB · Đọc: 13
Sao bạn không hỏi thêm tổ hợp.
Nếu hoán vị 20 cái tên vào 10 vị vị trí khác nhau thì thành bài toán tổ hợp.
 
Cảm ơn anh @HieuCD và @excel_lv1.5 nhiều ạ. Đúng là chỉ có VBA mới giải quyết được mà em thì chưa thạo.
Theo như em nhớ hồi lớp 11 học thì đây gọi tổ hợp chập 10 của 20, tức là có tối đa 184756 cell kết quả có thể được tạo ra. :D
=> Do đó em muốn khi kéo ô B1 xuống bên dưới nhiều nhiều nữa thì sẽ xuất ra 1 loạt tổ hợp nhấc 10 phần tử ngẫu nhiên không lặp lại trong số 20 phần tử cho trước ở cột A ạ. Mong anh cho em xin giải pháp, em cảm ơn nhiều ạ!
Ảnh chụp Màn hình 2019-01-23 lúc 22.56.56.png
 
Vấn đề này có ít nhất là 3 cách giải quyết:
1. cách dễ nhất, và nếu là bài tập thì chính là cách mà Thầy/Cô đòi hỏi: đặt một hàm Rand() vào cột kế bên, sort, lấy ra 10 cái.
2. dùng công thức khủng: tôn chỉ của tôi là công thức khủng chỉ dùng để vận động đầu óc giải đố mẹo. Vì vậy toi khong tiếp thêm.
3. dùng hàm tự tạo. Thuật toán lấy k phần tử ngẫu nhiên trong n phần tử đã được giải nhiều lần ở diễn đàn này rồi.

Chú: thuật toán ở bài #3 giản dị nhưng nếu (n-k)/n là số rất nhỏ, tức là k gần bằng n thì khả năng chạm số càng lúc càng cao và theo lý thuyết, bài toán có thể chạy vòng đi vòng lại khá lâu. Yêu cầu bài này (n-k)/n = 0,5 là số tương đối chấp nhận.
 
VetMini đã viết:
Vấn đề này có ít nhất là 3 cách giải quyết:
1. cách dễ nhất, và nếu là bài tập thì chính là cách mà Thầy/Cô đòi hỏi: đặt một hàm Rand() vào cột kế bên, sort, lấy ra 10 cái.
2. dùng công thức khủng: tôn chỉ của tôi là công thức khủng chỉ dùng để vận động đầu óc giải đố mẹo. Vì vậy toi khong tiếp thêm.
3. dùng hàm tự tạo. Thuật toán lấy k phần tử ngẫu nhiên trong n phần tử đã được giải nhiều lần ở diễn đàn này rồi.

Chú: thuật toán ở bài #3 giản dị nhưng nếu (n-k)/n là số rất nhỏ, tức là k gần bằng n thì khả năng chạm số càng lúc càng cao và theo lý thuyết, bài toán có thể chạy vòng đi vòng lại khá lâu. Yêu cầu bài này (n-k)/n = 0,5 là số tương đối chấp nhận.
Nhấp chuột vào đây để mở rộng...
--------------------
Lỗi tại em chưa hỏi hết ý ngay từ đầu ạ, em muốn render ra 1 loạt kết quả theo cách kéo B1 xuống dưới thì có thể tạo thêm các tổ hợp mới. Nên em nhờ các anh chị giúp em phần công thức để chạy ạ
Cảm ơn anh @@HieuCD và @@excel_lv1.5 nhiều ạ. Đúng là chỉ có VBA mới giải quyết được mà em thì chưa thạo.
Theo như em nhớ hồi lớp 11 học thì đây gọi tổ hợp chập 10 của 20, tức là có tối đa 184756 cell kết quả có thể được tạo ra. :D
=> Do đó em muốn khi kéo ô B1 xuống bên dưới nhiều nhiều nữa thì sẽ xuất ra 1 loạt tổ hợp nhấc 10 phần tử ngẫu nhiên không lặp lại trong số 20 phần tử cho trước ở cột A ạ. Mong anh cho em xin giải pháp, em cảm ơn nhiều ạ!
Nhấp chuột vào đây để mở rộng...
Ảnh chụp Màn hình 2019-01-23 lúc 22.56.56.png
 
Tôi đã nói là thuật toán tạo tổ hợp đã từng được bàn cặn kẽ ở diễn đàn này. Chịu khó tìm.
Số lớn thì khó chứ 30 phần tử trở xuống thì tương đối dễ.
 
VetMini đã viết:
Tôi đã nói là thuật toán tạo tổ hợp đã từng được bàn cặn kẽ ở diễn đàn này. Chịu khó tìm.
Số lớn thì khó chứ 30 phần tử trở xuống thì tương đối dễ.
Nhấp chuột vào đây để mở rộng...
thực ra là em muốn nhờ mọi người cho xin 1 công thức/code để sau nhập nhiều phần tử cho trước hơn, có thể tới 50 phần tử cung cấp sẵn và nhấc ra 10 phần tử ạ
 
Manhcuong1236985 đã viết:
Cảm ơn anh @HieuCD và @excel_lv1.5 nhiều ạ. Đúng là chỉ có VBA mới giải quyết được mà em thì chưa thạo.
Theo như em nhớ hồi lớp 11 học thì đây gọi tổ hợp chập 10 của 20, tức là có tối đa 184756 cell kết quả có thể được tạo ra. :D
=> Do đó em muốn khi kéo ô B1 xuống bên dưới nhiều nhiều nữa thì sẽ xuất ra 1 loạt tổ hợp nhấc 10 phần tử ngẫu nhiên không lặp lại trong số 20 phần tử cho trước ở cột A ạ. Mong anh cho em xin giải pháp, em cảm ơn nhiều ạ!
View attachment 211533
Nhấp chuột vào đây để mở rộng...
Thử code này, show tối đa số dòng của excel trong một cột thôi, thay đổi ô B1 để thay đổi số tổ hợp!
Mã: 
Sub combin()
Dim i As Long, j As Long, n As Long, m As Long, arr, darr, result, str As String
If [g1] <> "" Then Range("G1").CurrentRegion.Clear
arr = Range("A1:A" & [A100000].End(xlUp).Row):                m = UBound(arr):            n = [b1]
ReDim darr(1 To WorksheetFunction.combin(UBound(arr), n), 1 To n + 2)
For i = 1 To UBound(darr, 2) - 2
    darr(1, i + 1) = i
Next i
For i = 2 To UBound(darr)
    For j = 2 To UBound(darr, 2) - 1
        darr(i, j) = IIf(darr(i - 1, j) = m + j - n - 1, CDbl(darr(i, j - 1)) + 1, _
                     IIf(darr(i - 1, j + 1) = m + j - n Or CDbl(darr(i - 1, j + 1)) = 0, darr(i - 1, j) + 1, darr(i - 1, j)))
    Next j
Next i
ReDim result(1 To UBound(darr), 1 To 1)
For i = 1 To UBound(darr)
    str = ""
    For j = 2 To UBound(darr, 2) - 1
        str = str & IIf(str = "", "", " - ") & arr(darr(i, j), 1): result(i, 1) = str
    Next j
Next i
[g1].Resize(UBound(result), 1) = result
End Sub
 

File đính kèm

  • ex2.xlsb
    1.8 MB · Đọc: 14
excel_lv1.5 đã viết:
Thử code này, show tối đa số dòng của excel trong một cột thôi, thay đổi ô B1 để thay đổi số tổ hợp!
Mã: 
Sub combin()
Dim i As Long, j As Long, n As Long, m As Long, arr, darr, result, str As String
If [g1] <> "" Then Range("G1").CurrentRegion.Clear
arr = Range("A1:A" & [A100000].End(xlUp).Row):                m = UBound(arr):            n = [b1]
ReDim darr(1 To WorksheetFunction.combin(UBound(arr), n), 1 To n + 2)
For i = 1 To UBound(darr, 2) - 2
    darr(1, i + 1) = i
Next i
For i = 2 To UBound(darr)
    For j = 2 To UBound(darr, 2) - 1
        darr(i, j) = IIf(darr(i - 1, j) = m + j - n - 1, CDbl(darr(i, j - 1)) + 1, _
                     IIf(darr(i - 1, j + 1) = m + j - n Or CDbl(darr(i - 1, j + 1)) = 0, darr(i - 1, j) + 1, darr(i - 1, j)))
    Next j
Next i
ReDim result(1 To UBound(darr), 1 To 1)
For i = 1 To UBound(darr)
    str = ""
    For j = 2 To UBound(darr, 2) - 1
        str = str & IIf(str = "", "", " - ") & arr(darr(i, j), 1): result(i, 1) = str
    Next j
Next i
[g1].Resize(UBound(result), 1) = result
End Sub
Nhấp chuột vào đây để mở rộng...
Cái này là Chỉnh hợp có trật tự. Bạn ấy muốn ngẫu nhiên. Hình như bạn ấy còn muốn đánh vào Cell rồi Fill xuống
Code của bạn có thể để kiểm tra kết quả sau khi lấy
 
HeSanbi đã viết:
Cái này là Chỉnh hợp có trật tự. Bạn ấy muốn ngẫu nhiên. Hình như bạn ấy còn muốn đánh vào Cell rồi Fill xuống
Code của bạn có thể để kiểm tra kết quả sau khi lấy
Nhấp chuột vào đây để mở rộng...
Đã nói tổ hợp thì trật tự hay ngẫu nhiên cũng như nhau cả, nếu ngẫu nhiên thì chỉnh code lại tý là được nhưng code sẽ chậm hơn.
Mã: 
Sub combin()
Dim i As Long, j As Long, n As Long, m As Long, arr, darr, result, str As String, dic As Object, num As Long
Set dic = CreateObject("scripting.dictionary")
If [g1] <> "" Then Range("G1").CurrentRegion.Clear
arr = Range("A1:A" & [A100000].End(xlUp).Row):                m = UBound(arr):            n = [b1]
ReDim darr(1 To WorksheetFunction.combin(UBound(arr), n), 1 To n + 2)
For i = 1 To UBound(darr, 2) - 2
    darr(1, i + 1) = i
Next i
For i = 2 To UBound(darr)
    For j = 2 To UBound(darr, 2) - 1
        darr(i, j) = IIf(darr(i - 1, j) = m + j - n - 1, CDbl(darr(i, j - 1)) + 1, _
                     IIf(darr(i - 1, j + 1) = m + j - n Or CDbl(darr(i - 1, j + 1)) = 0, darr(i - 1, j) + 1, darr(i - 1, j)))
    Next j
Next i
ReDim result(1 To UBound(darr), 1 To 1)
Randomize
For i = 1 To UBound(darr)
    str = ""
    Do While dic.Count < n
    num = Int(Rnd() * n) + 1
        If Not dic.exists(num) Then dic.Add num, arr(darr(i, num + 1), 1)
    Loop
    str = Join(dic.items(), " - "): result(i, 1) = str: dic.RemoveAll
Next i
[g1].Resize(UBound(result), 1) = result
End Sub
 

File đính kèm

  • ex2.xlsb
    2.1 MB · Đọc: 20
excel_lv1.5 đã viết:
Đã nói tổ hợp thì trật tự hay ngẫu nhiên cũng như nhau cả, nếu ngẫu nhiên thì chỉnh code lại tý là được nhưng code sẽ chậm hơn.
Mã: 
Sub combin()
Dim i As Long, j As Long, n As Long, m As Long, arr, darr, result, str As String, dic As Object, num As Long
Set dic = CreateObject("scripting.dictionary")
If [g1] <> "" Then Range("G1").CurrentRegion.Clear
arr = Range("A1:A" & [A100000].End(xlUp).Row):                m = UBound(arr):            n = [b1]
ReDim darr(1 To WorksheetFunction.combin(UBound(arr), n), 1 To n + 2)
For i = 1 To UBound(darr, 2) - 2
    darr(1, i + 1) = i
Next i
For i = 2 To UBound(darr)
    For j = 2 To UBound(darr, 2) - 1
        darr(i, j) = IIf(darr(i - 1, j) = m + j - n - 1, CDbl(darr(i, j - 1)) + 1, _
                     IIf(darr(i - 1, j + 1) = m + j - n Or CDbl(darr(i - 1, j + 1)) = 0, darr(i - 1, j) + 1, darr(i - 1, j)))
    Next j
Next i
ReDim result(1 To UBound(darr), 1 To 1)
Randomize
For i = 1 To UBound(darr)
    str = ""
    Do While dic.Count < n
    num = Int(Rnd() * n) + 1
        If Not dic.exists(num) Then dic.Add num, arr(darr(i, num + 1), 1)
    Loop
    str = Join(dic.items(), " - "): result(i, 1) = str: dic.RemoveAll
Next i
[g1].Resize(UBound(result), 1) = result
End Sub
Nhấp chuột vào đây để mở rộng...
Sao đã có đoạn "WorksheetFunction.combin(UBound(arr), n)" biết được số Tập hợp rồi sao lại viết thêm vòng lặp để Randomize vậy
Cần có giải thuật khác. Giả sử không có số Tập hợp thì làm sao?
Đoạn code của bạn là liệt kê toàn bộ tập hợp sau đó chọn ngâu nhiên.
Nếu cho i Chạy hết Data-Type Double rồi quay lại tìm 10 số ngẫu nhiên. Vậy 10 tập ở cuối tập hợp sẽ lấy thế nào, khi nào mới lấy được?
 
Lần chỉnh sửa cuối:
HeSanbi đã viết:
Sao đã có đoạn "WorksheetFunction.combin(UBound(arr), n)" biết được số Tập hợp rồi sao lại viết thêm vòng lặp để Randomize vậy
Cần có giải thuật khác. Giả sử không có số Tập hợp thì làm sao?
Đoạn code của bạn là liệt kê toàn bộ tập hợp sau đó chọn ngâu nhiên.
Nếu cho i Chạy hết Data-Type Double rồi quay lại tìm 10 số ngẫu nhiên. Vậy 10 tập ở cuối tập hợp sẽ lấy thế nào, khi nào mới lấy được?
Nhấp chuột vào đây để mở rộng...
Randomize là ngẫu nhiên của số phần tử trong chuỗi, chứ tập số không đổi và luôn xác định vì combin(,) là tính chính xác số phần tử của tập rồi, muốn không show hết thì cho thêm const để xác định số phần tử cần show.
Đã có tập rồi thì chuyện lấy ngẫu nhiên chẳng phải quá đơn giản sao, bài #3 tôi viết lấy ngẫu nhiên từ một tập đó thôi.
Bạn thử đưa ra giải thuật khác xem, chứ tôi thấy cách này cũng không nhanh.
 
Lần chỉnh sửa cuối:
excel_lv1.5 đã viết:
Đã nói tổ hợp thì trật tự hay ngẫu nhiên cũng như nhau cả, nếu ngẫu nhiên thì chỉnh code lại tý là được nhưng code sẽ chậm hơn.
Mã: 
Sub combin()
Dim i As Long, j As Long, n As Long, m As Long, arr, darr, result, str As String, dic As Object, num As Long
Set dic = CreateObject("scripting.dictionary")
If [g1] <> "" Then Range("G1").CurrentRegion.Clear
arr = Range("A1:A" & [A100000].End(xlUp).Row):                m = UBound(arr):            n = [b1]
ReDim darr(1 To WorksheetFunction.combin(UBound(arr), n), 1 To n + 2)
For i = 1 To UBound(darr, 2) - 2
    darr(1, i + 1) = i
Next i
For i = 2 To UBound(darr)
    For j = 2 To UBound(darr, 2) - 1
        darr(i, j) = IIf(darr(i - 1, j) = m + j - n - 1, CDbl(darr(i, j - 1)) + 1, _
                     IIf(darr(i - 1, j + 1) = m + j - n Or CDbl(darr(i - 1, j + 1)) = 0, darr(i - 1, j) + 1, darr(i - 1, j)))
    Next j
Next i
ReDim result(1 To UBound(darr), 1 To 1)
Randomize
For i = 1 To UBound(darr)
    str = ""
    Do While dic.Count < n
    num = Int(Rnd() * n) + 1
        If Not dic.exists(num) Then dic.Add num, arr(darr(i, num + 1), 1)
    Loop
    str = Join(dic.items(), " - "): result(i, 1) = str: dic.RemoveAll
Next i
[g1].Resize(UBound(result), 1) = result
End Sub
Nhấp chuột vào đây để mở rộng...
------------------------------------------------------------------
Cảm ơn anh @excel_lv1.5 nhiều ạ! bác nhiệt tình quá tận hơn 1h sáng vẫn làm giúp em. Phân bố phần tử số lần xuất hiện bằng nhau quá chuẩn rồi!
Anh có thể giúp em đẩy kết quả thành 10 phần tử 1 tổ hợp được không ạ, tại vì ở file của anh đây em thấy xuất kết quả ra 1 tổ hợp mới có 8 phần tử. Thanks anh!
Capture.JPG
 
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

hoang.buivan93
Gặp rắc rối về phần công thức hàm tìm kiếm dữ liệu. Nhờ mọi người chỉ giáo giúp ạ.
Trả lời
2
Đọc
36
hoang.buivan93
hoang.buivan93
LuuAnh980
Sao Filter của Excel kỳ lạ.
Trả lời
1
Đọc
2
BuiQuangThuan
B
T
[Giúp đỡ] Tìm số lượng nhân viên đã tham gia làm lô hàng
Trả lời
3
Đọc
64
hoangtuaotrang_hp_vn
H
quangminhici
Tặng Addin Word xuất Mail Merge có chức năng cắt ra nhiều file và gửi mail.
    • Thích
Trả lời
8
Đọc
949
thientac
T
A
[Cần Giúp] Excel nhiều người dùng cùng lúc
Trả lời
5
Đọc
121
hvnhpro
H
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom