Giúp em ghép chỉnh hợp các từ với ạ

[vietcaothuhn]

Các anh chị ơi, em có 10 từ sau:

wire

wisdom

wise

wish

witness

wolf

woman

wonder

wood

wool

Làm sao để em tạo được chỉnh hợp chập 3 của tất cả các từ này này mà không lặp lại
Ví dụ wire wisdom wise
wire wisdom witness
wire wisdom wolf

 

[HieuCD]

Các anh chị ơi, em có 10 từ sau:

wire

wisdom

wise

wish

witness

wolf

woman

wonder

wood

wool

Làm sao để em tạo được chỉnh hợp chập 3 của tất cả các từ này này mà không lặp lại
Ví dụ wire wisdom wise
wire wisdom witness
wire wisdom wolf

10 từ lưu ở A2:A11, kết quả cột C
Ví dụ giống tổ hợp

Option Explicit
Sub ABC()
  Dim sArr(), Res, sRow&, i&, j&, tmp$
 
  sArr = Range("A2:A11").Value 'Vùng du lieu
  Res = Tohop_N_Chap_K(UBound(sArr), 3)
  For i = 1 To UBound(Res)
    tmp = Res(i, 1)
    For j = 1 To UBound(sArr)
      If Mid(tmp, j, 1) = "1" Then
        Res(i, 1) = Res(i, 1) & " " & sArr(j, 1)
      End If
    Next j
    Res(i, 1) = Mid(Res(i, 1), UBound(sArr) + 2, Len(Res(i, 1)))
  Next i
  Range("C2").Resize(UBound(Res)) = Res
End Sub

Private Function Tohop_N_Chap_K(ByVal N As Integer, ByVal k As Integer) As Variant
  'Tao to hop N chap K, bieu dien bang chuoi các ký tu "0" va "1"
  'Thu tu gia tri "1" là thu tu du lieu nguon lay du lieu
  Dim arr() As String, tmp$, j&, p&, s&
  ReDim arr(1 To Application.Combin(N, k), 1 To 1)
  tmp = String(k, "1") & String(N - k, "0")
  p = 1: arr(p, 1) = tmp
  Do
    j = InStrRev(tmp, "1")
    Mid(tmp, j, 1) = "0"
    Mid(tmp, j + 1, s + 1) = String(s + 1, "1")
    s = 0: p = p + 1:   arr(p, 1) = tmp
    If InStr(j + 1, tmp, "0") = 0 Then
      s = N - j
      Mid(tmp, j + 1, s) = String(s, "0")
    End If
  Loop Until s = k
  Tohop_N_Chap_K = arr
End Functio