Điền chữ không trùng lập có điều kiện

[hungdiep85]

Chào các Anh Chị

Chữ A: 6 (số có thể đổi)
Chữ B: 1 (số có thể đổi)
Điền 6 lần chữ A và 1 lần chữ B, kết quả mỗi hàng không trùng lập nhau.

Chữ A: 6 (số có thể đổi)
Chữ B: 2 (số có thể đổi)
Điền 6 lần chữ A và 2 lần chữ B, kết quả mỗi hàng không trùng lập nhau.

Chữ A: 6 (số có thể đổi)
Chữ B: 3 (số có thể đổi)
Điền 6 lần chữ A và 3 lần chữ B, kết quả mỗi hàng không trùng lập nhau.

Anh Chị có thể giúp em code công thức trên với, công việc lập đi lập lại hàng ngày. em làm bằng tay đâu cả đầu.

Em cảm ơn trước àh

 

[mandala]

Sub TH1()
For i = 1 To 7
For j = 1 To 7
' A
Cells(i + 5, j + 2) = Range("B3")
' B
Cells(i + 5, i + 2) = Range("C3")
Next j
Next i
End Sub

 

[VetMini]

Loại bài này ở đây đã có khá nhiều. Chịu khó tìm và động não chút.

 

[CHAOQUAY]

Chào các Anh Chị

Chữ A: 6 (số có thể đổi)
Chữ B: 1 (số có thể đổi)
Điền 6 lần chữ A và 1 lần chữ B, kết quả mỗi hàng không trùng lập nhau.

Chữ A: 6 (số có thể đổi)
Chữ B: 2 (số có thể đổi)
Điền 6 lần chữ A và 2 lần chữ B, kết quả mỗi hàng không trùng lập nhau.

Chữ A: 6 (số có thể đổi)
Chữ B: 3 (số có thể đổi)
Điền 6 lần chữ A và 3 lần chữ B, kết quả mỗi hàng không trùng lập nhau.

Anh Chị có thể giúp em code công thức trên với, công việc lập đi lập lại hàng ngày. em làm bằng tay đâu cả đầu.

Em cảm ơn trước àh

Thử code dưới xem sao

Option Explicit
Public Kq
Sub DienAB()
Dim DK
Dim MangA
Dim i, j, k
Dim Sh As Worksheet
For Each Sh In Worksheets
    DK = Sh.Range("B2").CurrentRegion
    k = DK(2, 1) + DK(2, 2)
    ReDim MangA(1 To k)
    i = WorksheetFunction.Combin(k, DK(2, 2))
    ReDim Kq(1 To i, 1 To k)
    For j = 1 To UBound(MangA)
        MangA(j) = "A"
    Next j
    Lap ByVal MangA, ByVal 1, ByVal 0, DK(2, 2), 0
    Sh.Range("B6").End(xlDown).Offset(2, 1).Resize(i, k).ClearContents
    Sh.Range("B6").End(xlDown).Offset(2, 1).Resize(i, k) = Kq
Next Sh
End Sub
Sub Lap(ByVal Mang, ByVal Vtr, ByVal Sllp, Sl, k)
Dim i
Dim Mang_
If Sllp = Sl Then
    k = k + 1
    For i = 1 To UBound(Mang)
        Kq(k, i) = Mang(i)
    Next i
Else
    Sllp = Sllp + 1
    For i = Vtr To UBound(Mang) - (Sl - Sllp)
        Mang_ = Mang
        Mang_(i) = "B"
        Lap ByVal Mang_, ByVal i + 1, ByVal Sllp, Sl, k
    Next i
End If
End Sub

 

[VetMini]

Thử code dưới xem sao
...

Chỉ có 2 kiểu thì thuật toán dễ nhất là Binary.
Bài này đã được giải trong thớt nói về "phá Password"

 

[hungdiep85]

Thử code dưới xem sao

Option Explicit
Public Kq
Sub DienAB()
Dim DK
Dim MangA
Dim i, j, k
Dim Sh As Worksheet
For Each Sh In Worksheets
    DK = Sh.Range("B2").CurrentRegion
    k = DK(2, 1) + DK(2, 2)
    ReDim MangA(1 To k)
    i = WorksheetFunction.Combin(k, DK(2, 2))
    ReDim Kq(1 To i, 1 To k)
    For j = 1 To UBound(MangA)
        MangA(j) = "A"
    Next j
    Lap ByVal MangA, ByVal 1, ByVal 0, DK(2, 2), 0
    Sh.Range("B6").End(xlDown).Offset(2, 1).Resize(i, k).ClearContents
    Sh.Range("B6").End(xlDown).Offset(2, 1).Resize(i, k) = Kq
Next Sh
End Sub
Sub Lap(ByVal Mang, ByVal Vtr, ByVal Sllp, Sl, k)
Dim i
Dim Mang_
If Sllp = Sl Then
    k = k + 1
    For i = 1 To UBound(Mang)
        Kq(k, i) = Mang(i)
    Next i
Else
    Sllp = Sllp + 1
    For i = Vtr To UBound(Mang) - (Sl - Sllp)
        Mang_ = Mang
        Mang_(i) = "B"
        Lap ByVal Mang_, ByVal i + 1, ByVal Sllp, Sl, k
    Next i
End If
End Sub

Dạ em đã thử code, code chạy đúng hết rồi anh,
Em cảm ơn Anh và các Anh chị trên diễn đàn GPE nhiều àh

Bài đã được tự động gộp: 16/4/19

Dạ em đã thử code, code chạy đúng hết rồi anh,
Em cảm ơn Anh và các Anh Chị trên diễn đàn GPE nhiều àh

Bài đã được tự động gộp: 16/4/19

Dạ em đã thử code, code chạy đúng hết rồi anh,
Em cảm ơn Anh và các Anh Chị trên diễn đàn GPE nhiều àh