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

Manhcuong1236985 · 24/1/19

phuocam đã viết:
Bạn nhập số 10 tại B1 rồi chạy thử code.

Yeah em đã nhìn thấy cảm ơn bác

HieuCD · 24/1/19

Manhcuong1236985 đã viết:
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ử ạ

Thử code

Mã:

Sub Combin_Main()
  Dim sArr(), Res() As String, iRnd() As Long, Res2() As String
  Dim K As Long, S As Long, sRow As Long, N As Long, i As Long
 
  Range("E1", Range("E1000010").End(xlUp)).ClearContents
  Range("C4").ClearContents
  sArr = Range("A1:A" & Range("A1000000").End(xlUp).Row).Value
  N = UBound(sArr)
  K = Range("C1").Value:   S = Range("C2").Value
  If S <= 0 Or K <= 0 Then MsgBox ("Phai nhap so vào 2 ô C1 và C2"): Exit Sub
  If K > N Then MsgBox ("Giá tri K phai nho hon so dòng du lieu"): Exit Sub
 
  sRow = WorksheetFunction.Combin(N, K)
  Range("C4") = sRow
  If sRow > 1000000 Then sRow = 1000000
  If S > sRow Then S = sRow
 
  iRnd = UniqueRand(sRow, S)
  Call Combin(Res, sArr, K, iRnd(S))
 
  ReDim Res2(1 To S, 1 To 1)
  For i = 1 To S
    Res2(i, 1) = Res(iRnd(i), 1)
  Next i
  Range("E1").Resize(S) = Res2
  Erase Res
End Sub

Private Function UniqueRand(ByVal N As Long, ByVal K As Long) As Variant
  Dim sArr() As Long, blArr() As Boolean, Res() As Long, i As Long, RndNum As Long
 
  ReDim sArr(1 To N)
  For i = 1 To N
    sArr(i) = i
  Next i
  ReDim blArr(1 To N):  ReDim Res(1 To K)
  For i = 1 To K
    RndNum = Int(N * Rnd() + 1)
    blArr(sArr(RndNum)) = True
    sArr(RndNum) = sArr(N)
    N = N - 1
  Next i
  K = 0: N = UBound(sArr)
  For i = 1 To N
    If blArr(i) = True Then
      K = K + 1:      Res(K) = i
    End If
  Next i
  UniqueRand = Res
End Function

Private Sub Combin(ByRef Res, ByVal sArr, ByVal K As Long, ByVal sRow As Long)
  Dim iD() As Long, tmp() As String
  Dim N As Long, i As Long, j As Long, q As Long
 
  N = UBound(sArr):   K = Range("C1").Value
  ReDim Res(1 To sRow, 1 To 1)
  ReDim iD(1 To K): ReDim tmp(1 To K)
  For j = 1 To K
    iD(j) = j: tmp(j) = sArr(j, 1)
  Next j
  Res(1, 1) = Join(tmp, " - ")
  For i = 2 To sRow
    For j = 1 To K - 1
      If iD(j + 1) = N - K + j + 1 Then
        iD(j) = iD(j) + 1
        tmp(j) = sArr(iD(j), 1)
        For q = j + 1 To K
          iD(q) = iD(q - 1) + 1
          tmp(q) = sArr(iD(q), 1)
        Next q
        Exit For
      ElseIf j = K - 1 Then
        iD(K) = iD(K) + 1
        tmp(K) = sArr(iD(K), 1)
      End If
    Next j
    Res(i, 1) = Join(tmp, " - ")
  Next i
End Sub

HeSanbi · 24/1/19

HieuCD đã viết:

Thử code

Mã:

Sub Combin_Main()
  Dim sArr(), Res() As String, iRnd() As Long, Res2() As String
  Dim K As Long, S As Long, sRow As Long, N As Long, i As Long

  Range("E1", Range("E1000010").End(xlUp)).ClearContents
  Range("C4").ClearContents
  sArr = Range("A1:A" & Range("A1000000").End(xlUp).Row).Value
  N = UBound(sArr)
  K = Range("C1").Value:   S = Range("C2").Value
  If S <= 0 Or K <= 0 Then MsgBox ("Phai nhap so vào 2 ô C1 và C2"): Exit Sub
  If K > N Then MsgBox ("Giá tri K phai nho hon so dòng du lieu"): Exit Sub

  sRow = WorksheetFunction.Combin(N, K)
  Range("C4") = sRow
  If sRow > 1000000 Then sRow = 1000000
  If S > sRow Then S = sRow

  iRnd = UniqueRand(sRow, S)
  Call Combin(Res, sArr, K, iRnd(S))

  ReDim Res2(1 To S, 1 To 1)
  For i = 1 To S
    Res2(i, 1) = Res(iRnd(i), 1)
  Next i
  Range("E1").Resize(S) = Res2
  Erase Res
End Sub

Private Function UniqueRand(ByVal N As Long, ByVal K As Long) As Variant
  Dim sArr() As Long, blArr() As Boolean, Res() As Long, i As Long, RndNum As Long

  ReDim sArr(1 To N)
  For i = 1 To N
    sArr(i) = i
  Next i
  ReDim blArr(1 To N):  ReDim Res(1 To K)
  For i = 1 To K
    RndNum = Int(N * Rnd() + 1)
    blArr(sArr(RndNum)) = True
    sArr(RndNum) = sArr(N)
    N = N - 1
  Next i
  K = 0: N = UBound(sArr)
  For i = 1 To N
    If blArr(i) = True Then
      K = K + 1:      Res(K) = i
    End If
  Next i
  UniqueRand = Res
End Function

Private Sub Combin(ByRef Res, ByVal sArr, ByVal K As Long, ByVal sRow As Long)
  Dim iD() As Long, tmp() As String
  Dim N As Long, i As Long, j As Long, q As Long

  N = UBound(sArr):   K = Range("C1").Value
  ReDim Res(1 To sRow, 1 To 1)
  ReDim iD(1 To K): ReDim tmp(1 To K)
  For j = 1 To K
    iD(j) = j: tmp(j) = sArr(j, 1)
  Next j
  Res(1, 1) = Join(tmp, " - ")
  For i = 2 To sRow
    For j = 1 To K - 1
      If iD(j + 1) = N - K + j + 1 Then
        iD(j) = iD(j) + 1
        tmp(j) = sArr(iD(j), 1)
        For q = j + 1 To K
          iD(q) = iD(q - 1) + 1
          tmp(q) = sArr(iD(q), 1)
        Next q
        Exit For
      ElseIf j = K - 1 Then
        iD(K) = iD(K) + 1
        tmp(K) = sArr(iD(K), 1)
      End If
    Next j
    Res(i, 1) = Join(tmp, " - ")
  Next i
End Sub

Ngẫu nhiên sao mà A1 xếp đều vậy anh.
Ví dụ muốn biết Chỉnh hợp 50 chập 10 trong hoán vị P50 tại vị trí P50 - 200 được sắp xếp thế nào thì sao
(50 học sinh xếp vào 10 vị trí bất kí sau đó lấy ra vị trí thứ 18000 xem sắp xếp thế nào. Chắc dùng vòng lặp chạy đến 18000)
Không biết có được không

CHAOQUAY · 25/1/19

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!

Có lẽn bạn cần phân biệt rõ là tổ hợp hay không.
Vi dụ : Nhóm 1,2,3,4,5,6,7,8,9,10 và 10,9,8,7,6,5,4,3,2,1 theo yêu cầu của bạn là 2 nhóm khác nhau hay là không

Manhcuong1236985 · 25/1/19

CHAOQUAY đã viết:
Có lẽn bạn cần phân biệt rõ là tổ hợp hay không.
Vi dụ : Nhóm 1,2,3,4,5,6,7,8,9,10 và 10,9,8,7,6,5,4,3,2,1 theo yêu cầu của bạn là 2 nhóm khác nhau hay là không

Em ghi là tổ hợp thì không phân biệt thứ tự miễn là có đủ các phần tử như vậy. Còn nếu ghi theo cách của anh thì gọi là chỉnh hợp, số lượng phần tử sẽ lớn hơn rất nhiều.

CHAOQUAY · 25/1/19

Manhcuong1236985 đã viết:
Em ghi là tổ hợp thì không phân biệt thứ tự miễn là có đủ các phần tử như vậy. Còn nếu ghi theo cách của anh thì gọi là chỉnh hợp, số lượng phần tử sẽ lớn hơn rất nhiều.

Vì thấy mấy bài nói tới chỉnh hợp & hoán vị nen hỏi cho chắc vậy.

HieuCD · 25/1/19

HeSanbi đã viết:
Ngẫu nhiên sao mà A1 xếp đều vậy anh.
Ví dụ muốn biết Chỉnh hợp 50 chập 10 trong hoán vị P50 tại vị trí P50 - 200 được sắp xếp thế nào thì sao
(50 học sinh xếp vào 10 vị trí bất kí sau đó lấy ra vị trí thứ 18000 xem sắp xếp thế nào. Chắc dùng vòng lặp chạy đến 18000)
Không biết có được không

Code mình đã có thêm 2 đoạn lệnh xếp thứ tự cho dể nhìn, không xếp thứ tự thì bỏ các lệnh nầy cho ra vẽ ngẫu nhiên
Vị trí thứ 18000 chỉ là tương đối, tùy theo cách xếp thứ tự như thế nào, bài toán ngẫu nhiên nên thứ tự bao nhiêu không quan trọng
Nếu xếp thứ tự theo qui luật như trong file của mình, lấy vị trí nào đó như thứ tự 18000 thì bạn tự viết code được
Nếu muốn code chạy nhanh cần phân tích tình huống để chọn cách xử lý, chủ yếu dựa vào tương quan số khả năng và số dòng cần lấy

concogia · 26/1/19

Theo đề trong bài #22 của bạn HieuCD, ( lấy 10 phần tử bất kỳ, không trùng trong 20 phần tử cho trước, số dòng lấy....tùy hỷ) tui đố hội người cao tuổi viết được code với số vòng lặp ngắn nhất có thể, ai viết được đầu năm tui thưởng.......(bí mật)
CHÚC MỪNG NĂM MỚI.........SỚM

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

Manhcuong1236985

Thành viên mới

HieuCD

Chuyên gia GPE

File đính kèm

HeSanbi

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

CHAOQUAY

Thành viên gắn bó

Manhcuong1236985

Thành viên mới

CHAOQUAY

Thành viên gắn bó

HieuCD

Chuyên gia GPE

concogia

Gội rồi mới Cạo

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

Facebook

Group

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