[Hỏi] Cách liệt kê tất cả tổ hợp chập k của n phần tử

Liên hệ QC

Tunga2k41

Thành viên mới
Tham gia
19/3/08
Bài viết
33
Được thích
0
Đề bài: Cho các số tự nhiên: 0,1,2,3,4,5,6,7,8,9
Tìm và liệt kê các tập con của: tổ hợp chập 4 của 10 phần tử trên và viết thành 1 cột?

Cụ thể nó sẽ ra 210 kết quả và xếp thành 1 cột:
0123
0124
0125
...
6789

Mong các anh chị giúp đỡ, bài này chỉ giải trên Excel. Trình bày thế nào cũng được miễn sao ra kết quả là được ạ!
 
Lần chỉnh sửa cuối:
Đề bài: Cho các số tự nhiên: 0,1,2,3,4,5,6,7,8,9
Tìm và liệt kê các tập con của: tổ hợp chập 4 của 10 phần tử trên và viết thành 1 cột?

Cụ thể nó sẽ ra 210 kết quả và xếp thành 1 cột:
01234
01235
01236
...
56789

Mong các anh chị giúp đỡ, bài này chỉ giải trên Excel. Trình bày thế nào cũng được miễn sao ra kết quả là được ạ!
Trên thì là chập 4, kết quả yêu cầu là chập 5, vậy là chập nào bạn.
 
Sơ xuất quá :pChập 4 của 10 nhé các bác!
Kết quả dạng này:
0123
0124
0125
...
6789
 
Sơ xuất quá :pChập 4 của 10 nhé các bác!
Kết quả dạng này:
0123
0124
0125
...
6789
copy đoạn code dưới đây
Mở file mới
Nhấn Alt + F11
Nhấn Alt + I + M
Nhấn Ctrl + V
Nhấn Alt + Q
Nhấn Alt + F8

Vụ chập này có vẻ hay đấy%#^#$

Mã:
Public Sub Tunga2k41()
Dim i, j, k, x, z, res(1 To 210, 1 To 1)
Dim th(3)
For i = 1 To 6
    th(0) = i
    For j = i + 1 To 7
        th(1) = j
        For k = j + 1 To 8
            th(2) = k
            For x = k + 1 To 9
                th(3) = x
                z = z + 1
                res(z, 1) = Join(th)
            Next x
        Next k
    Next j
Next i
With Sheet1
.UsedRange.ClearContents
.Range("A3").Resize(UBound(res), UBound(res, 2)) = res
.UsedRange.Columns.AutoFit
End With
End Sub
 
copy đoạn code dưới đây
Mở file mới
Nhấn Alt + F11
Nhấn Alt + I + M
Nhấn Ctrl + V
Nhấn Alt + Q
Nhấn Alt + F8

Vụ chập này có vẻ hay đấy%#^#$

Mã:
Public Sub Tunga2k41()
Dim i, j, k, x, z, res(1 To 210, 1 To 1)
Dim th(3)
For i = 1 To 6
    th(0) = i
    For j = i + 1 To 7
        th(1) = j
        For k = j + 1 To 8
            th(2) = k
            For x = k + 1 To 9
                th(3) = x
                z = z + 1
                res(z, 1) = Join(th)
            Next x
        Next k
    Next j
Next i
With Sheet1
.UsedRange.ClearContents
.Range("A3").Resize(UBound(res), UBound(res, 2)) = res
.UsedRange.Columns.AutoFit
End With
End Sub
Hay quá bác ơi! Trong excel thì chắc còn mỗi cách dùng VBA thôi bác nhỉ. Em xin cảm ơn bác!!!
Cho em hỏi thêm là: bây giờ không dùng các số tự nhiên 0,1,2,3,4,5,6,7,8,9 nữa mà dùng ký tự bất kỳ (không theo quy luật số đếm)
A1 là 1 ký tự A
A2 là 1 ký tự B
A3 là 1 ký tự C
...
A10 là 1 ký tự J
Thì cách làm như nào? Hiện e chỉ biết áp dụng qua cách của bác sau đó replace số 0->A, 1->B, 2->C, .., 9->J
 
Hay quá bác ơi! Trong excel thì chắc còn mỗi cách dùng VBA thôi bác nhỉ. Em xin cảm ơn bác!!!
Cho em hỏi thêm là: bây giờ không dùng các số tự nhiên 0,1,2,3,4,5,6,7,8,9 nữa mà dùng ký tự bất kỳ (không theo quy luật số đếm)
A1 là 1 ký tự A
A2 là 1 ký tự B
A3 là 1 ký tự C
...
A10 là 1 ký tự J
Thì cách làm như nào? Hiện e chỉ biết áp dụng qua cách của bác sau đó replace số 0->A, 1->B, 2->C, .., 9->J
Thêm 1 mảng danh sách tên các phần tử, áp vào là được.
Danh sách này bạn giả lập vào file nào đó gửi lên cho tiện
 
Em nhờ các bác expert excel giúp em ah!
Em có 1 list các vận động viên (VĐV) tham gia giải (15-20 người) và các VĐV này sẽ đấu vòng tròn với nhau. (theo em hiểu là Tổ hợp n chập 2)
Và em cần là khi nhập tên các VĐV (tab#1) thì excel sẽ liệt kê số trận đấu giữa các VĐV (tab#2)
Mong các ace giúp đỡ!
 

File đính kèm

  • Liệt kê tổ hợp n chập k=2.xlsx
    12.9 KB · Đọc: 35
Em nhờ các bác expert excel giúp em ah!
Em có 1 list các vận động viên (VĐV) tham gia giải (15-20 người) và các VĐV này sẽ đấu vòng tròn với nhau. (theo em hiểu là Tổ hợp n chập 2)
Và em cần là khi nhập tên các VĐV (tab#1) thì excel sẽ liệt kê số trận đấu giữa các VĐV (tab#2)
Mong các ace giúp đỡ!
Bạn nên xem nội quy diễn đàn, không dùng các từ viết tắt và từ tiếng Anh không cần thiết
Dùng hàm Excel với các cột phụ. Xem công thức trong file
 

File đính kèm

  • Liệt kê tổ hợp n chập k=2.xlsx
    18.7 KB · Đọc: 53
Cám ơn @HieuCD đã giúp ah! Nếu được thì bạn có thể chỉ giúp cách sắp xếp thứ tự các trận đấu theo thể thức vòng tròn (theo vòng). Xin phép đính kèm 1 ví dụ sắp xếp lịch thi đấu vòng tròn của 15 đội (từ vòng 1 đến vòng 15). Xin cám ơn ah!
 

File đính kèm

  • Vi du_Lich thi dau vong tron cua 15 doi thi dau.docx
    107.3 KB · Đọc: 9
Đề bài: Cho các số tự nhiên: 0,1,2,3,4,5,6,7,8,9
Tìm và liệt kê các tập con của: tổ hợp chập 4 của 10 phần tử trên và viết thành 1 cột?

Cụ thể nó sẽ ra 210 kết quả và xếp thành 1 cột:
0123
0124
0125
...
6789

Mong các anh chị giúp đỡ, bài này chỉ giải trên Excel. Trình bày thế nào cũng được miễn sao ra kết quả là được ạ!
Liên kết: https://www.youtube.com/watch?v=XykaqNHnlag
xem clip này nha.
Lỡ đăng rồi, nhìn lại thì thấy mấy năm rồi thôi hihi
 
Cám ơn @HieuCD đã giúp ah! Nếu được thì bạn có thể chỉ giúp cách sắp xếp thứ tự các trận đấu theo thể thức vòng tròn (theo vòng). Xin phép đính kèm 1 ví dụ sắp xếp lịch thi đấu vòng tròn của 15 đội (từ vòng 1 đến vòng 15). Xin cám ơn ah!
Nhập tên vận động viên vào sheet "Ten", chạy sub XYZ xếp lịch thi đấu "sheet1"
Mã:
Option Explicit
  Dim a, S, sTran&, sVong&, sD&
  Dim n&, i&, r&, k&, j&, j2&, c&, t&, z&, iKey$, iKey2$
 
Sub XYZ()
  Dim sArr(), res(), dic As Object, sDoi&
 
  Randomize
  Set dic = CreateObject("scripting.dictionary")
  With Sheets("Ten")
    sArr = .Range("B4", .Range("B" & Rows.Count).End(xlUp)).Value
  End With
  sDoi = UBound(sArr)
  Call XepLich(res, sArr, dic, sDoi)
 
  n = UBound(res)
  For j = 1 To sVong 'Gan ten cac doi
    For i = 1 To sTran
      S = Split(res(i, j), "_")
      res(i, j) = sArr(CLng(S(0)), 1) & "_" & sArr(CLng(S(1)), 1)
    Next i
    If n > sTran Then res(n, j) = sArr(res(n, j), 1)
  Next j
  Sheets("Sheet1").Range("B4:X100").ClearContents
  Sheets("Sheet1").Range("B4").Resize(n, sVong) = res
End Sub

Private Sub XepLich(res, sArr, dic, sDoi)
  Dim bDoiLe As Boolean
 
  bDoiLe = ((sDoi Mod 2) = 1)
  If bDoiLe Then sVong = sDoi Else sVong = sDoi - 1  'So vong dau
  sTran = sDoi \ 2 'So Tran 1 vong
  sD = sTran * 2 'so Doi 1 vong
TuDau:
  If bDoiLe = True Then
    ReDim res(1 To sTran + 1, 1 To sVong)
    a = UniqueRand(sVong)
    For n = 1 To sVong
      res(sTran + 1, n) = a(n)
    Next n
  Else
    ReDim res(1 To sTran, 1 To sVong)
  End If
  For n = 1 To sVong
TroLai:
    If bDoiLe = True Then
      a = CreateUniqueRand(sDoi, res(sTran + 1, n))
    Else
      a = UniqueRand(sD)
    End If
    k = 0: i = 0
    Do While k < sTran
      i = i + 1
      If a(i) <> Empty Then
        k = k + 1
        res(k, n) = a(i)
        a(i) = Empty
        For j = i + 1 To sD '***
          If a(j) <> Empty Then
            iKey = KeyValue(res(k, n), a(j))
            If dic.exists(iKey) = False Then
              dic.Add iKey, ""
              res(k, n) = iKey
              a(j) = Empty
              Exit For
            End If
          End If
        Next j
        If j = sD + 1 Then '***
          For r = 1 To k - 1
            S = Split(res(r, n), "_")
            For c = 0 To 1
              iKey = KeyValue(res(k, n), S(c))
              If dic.exists(iKey) = False Then
                If c = 0 Then t = S(1) Else t = S(0)
                For j2 = i + 1 To sD '***
                  If a(j2) <> Empty Then
                    iKey2 = KeyValue(t, a(j2))
                    If dic.exists(iKey2) = False Then
                      dic.Remove (res(r, n))
                      res(r, n) = iKey2:       res(k, n) = iKey
                      dic.Add iKey, "":       dic.Add iKey2, ""
                      a(j2) = Empty
                      GoTo Thoat
                    End If
                  End If
                Next j2
              End If
            Next c
          Next r
          If r = k Then '****
            z = z + 1
            If z = 50 Then dic.RemoveAll:       z = 0:   GoTo TuDau
            Call RemoveDic(res, dic)
            GoTo TroLai
          End If
        End If
      End If
Thoat:
    Loop
  Next n
End Sub

Private Sub RemoveDic(ByRef res, ByRef dic)
  For r = 1 To k - 1
    dic.Remove (res(r, n))
  Next r
End Sub

Private Function KeyValue(ByVal val_1, ByVal val_2) As String
  If CLng(val_1) < CLng(val_2) Then
    KeyValue = val_1 & "_" & val_2
  Else
    KeyValue = val_2 & "_" & val_1
  End If
End Function

Private Function CreateUniqueRand(ByVal n As Long, ByVal notNum) As Variant
  Dim arr, res, i&, k&
  arr = UniqueRand(n)
  ReDim res(1 To n - 1)
  For i = 1 To n
    If arr(i) <> notNum Then
      k = k + 1
      res(k) = arr(i)
    End If
  Next i
  CreateUniqueRand = res
End Function

Private Function UniqueRand(ByVal n As Long) As Variant
  Dim arr() As Long, i&, RndNum&, tmp&
  ReDim arr(1 To n)
  'Randomize
  For i = 1 To n
    RndNum = Int(n * Rnd() + 1)
    If arr(RndNum) = 0 Then tmp = RndNum Else tmp = arr(RndNum)
    If arr(n) = 0 Then arr(RndNum) = n Else arr(RndNum) = arr(n)
    arr(n) = tmp
    n = n - 1
  Next i
  UniqueRand = arr
End Function
 

File đính kèm

  • Liệt kê tổ hợp n chập k=2.xlsm
    27 KB · Đọc: 36
Bạn nên xem nội quy diễn đàn, không dùng các từ viết tắt và từ tiếng Anh không cần thiết
Dùng hàm Excel với các cột phụ. Xem công thức trong file
Giúp mình với.
Mình có ví Metamart đã ghi 12 kí tự để restore, tuy nhiên khi nhập vào báo là không phù hợp.
12 kí tự là: fox, arena, repeat, craft, excite, jealous, machanic, vital, air, satoshi, slender, happy
Mình nghĩ là trong quá trình ghi lại kí tự bị nhầm vị trí, nên nhờ addmin và các bậc tiền bồi giúp mình làm file liệt kê kết quả tổ hợp 12 kí tự này với ạ.
mình hiểu là tổ hợp 12 của 12 nhưng mình không biết làm. Rất mong các anh em giúp đỡ.
Kết quả xin gửi về mail: hieunv@phucsongroup.com.vn
Xin trân trọng cảm ơn!
 
Giúp mình với.
Mình có ví Metamart đã ghi 12 kí tự để restore, tuy nhiên khi nhập vào báo là không phù hợp.
12 kí tự là: fox, arena, repeat, craft, excite, jealous, machanic, vital, air, satoshi, slender, happy
Mình nghĩ là trong quá trình ghi lại kí tự bị nhầm vị trí, nên nhờ addmin và các bậc tiền bồi giúp mình làm file liệt kê kết quả tổ hợp 12 kí tự này với ạ.
mình hiểu là tổ hợp 12 của 12 nhưng mình không biết làm. Rất mong các anh em giúp đỡ.
Kết quả xin gửi về mail: hieunv@phucsongroup.com.vn
Xin trân trọng cảm ơn!
Hình như PERMUT(12,12) = 479 001 600 kết quả.

.
 
Yêu cầu không cần chạy 1 lần ra kết quả, cứ lấy từng khúc là được.
 
Giúp mình với.
Mình có ví Metamart đã ghi 12 kí tự để restore, tuy nhiên khi nhập vào báo là không phù hợp.
12 kí tự là: fox, arena, repeat, craft, excite, jealous, machanic, vital, air, satoshi, slender, happy
Mình nghĩ là trong quá trình ghi lại kí tự bị nhầm vị trí, nên nhờ addmin và các bậc tiền bồi giúp mình làm file liệt kê kết quả tổ hợp 12 kí tự này với ạ.
mình hiểu là tổ hợp 12 của 12 nhưng mình không biết làm. Rất mong các anh em giúp đỡ.
Kết quả xin gửi về mail: hieunv@phucsongroup.com.vn
Xin trân trọng cảm ơn!
Liệt kê gần 500.000.000 giá trị rồi làm gì tiếp?
 
Web KT
Back
Top Bottom