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

Blue Softs epl 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:

TheThienChu

Thành viên tiêu biểu
Tham gia
21/11/15
Bài viết
498
Được thích
260
Giới tính
Nam
Đề 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.
 

Tunga2k41

Thành viên mới
Tham gia
19/3/08
Bài viết
33
Được thích
0
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
 

TheThienChu

Thành viên tiêu biểu
Tham gia
21/11/15
Bài viết
498
Được thích
260
Giới tính
Nam
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
 

Tunga2k41

Thành viên mới
Tham gia
19/3/08
Bài viết
33
Được thích
0
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
 

TheThienChu

Thành viên tiêu biểu
Tham gia
21/11/15
Bài viết
498
Được thích
260
Giới tính
Nam
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
 

ecohuy

Thành viên mới
Tham gia
23/6/06
Bài viết
2
Được thích
0
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: 9

HieuCD

Chuyên gia GPE
Tham gia
14/9/10
Bài viết
8,585
Được thích
18,244
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: 12

ecohuy

Thành viên mới
Tham gia
23/6/06
Bài viết
2
Được thích
0
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: 3

phihndhsp

Thành viên gạo cội
Tham gia
26/12/09
Bài viết
3,345
Được thích
2,456
Giới tính
Nam
Nghề nghiệp
Giáo Viên
Đề 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
 

HieuCD

Chuyên gia GPE
Tham gia
14/9/10
Bài viết
8,585
Được thích
18,244
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: 9

hieuhieuvp

Thành viên mới
Tham gia
25/11/21
Bài viết
3
Được thích
0
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!
 

Phuocam

Thành viên mới
Tham gia
16/5/13
Bài viết
3,613
Được thích
5,210
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ả.

.
 

huuthang_bd

Chuyên gia GPE
Tham gia
10/9/08
Bài viết
8,258
Được thích
9,769
Donate (Momo)
Donate
Giới tính
Nam
Nghề nghiệp
CPA
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.
 

HieuCD

Chuyên gia GPE
Tham gia
14/9/10
Bài viết
8,585
Được thích
18,244
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
Top Bottom