Xin Giúp: Điền k phần tử ("x") giống nhau vào ma trận với hàng và cột cho trước (1 người xem)

[mapcongtu]

Xin chào cả nhà GPE,

Tôi có 1 vấn đề cần mọi người tư vấn và giúp đoạn code để Điền k phần tử ("x") giống nhau vào ma trận với hàng và cột cho trước.

Dữ liệu đầu vào sẽ như sau
+ Số lượng chữ x cần nhập: 2 ( có thể thay đổi 3, 4, 5, nhưng luôn bé hơn tổng cột)
+ Tổng Hàng: 12
+ Tổng Cột: 4
+ Dữ Liệu ghi vào cột: D

**Đầu ra:
+ Mong muốn mỗi hàng sẽ chỉ có 2 chữ x mà thôi.
+ Các hàng sẽ có dữ liệu khác nhau, đến khi hết các tổ hợp có thể có thì có thể lặp lại cho đến khi duyệt qua hết các hàng.
+ Mọi người xem file đính kèm nhé, tôi có ví dụ minh họa.

Xin Cảm Ơn.

 

[vanthinh3101]

Xin chào cả nhà GPE,

Tôi có 1 vấn đề cần mọi người tư vấn và giúp đoạn code để Điền k phần tử ("x") giống nhau vào ma trận với hàng và cột cho trước.

Dữ liệu đầu vào sẽ như sau
+ Số lượng chữ x cần nhập: 2 ( có thể thay đổi 3, 4, 5, nhưng luôn bé hơn tổng cột)
+ Tổng Hàng: 12
+ Tổng Cột: 4
+ Dữ Liệu ghi vào cột: D

**Đầu ra:
+ Mong muốn mỗi hàng sẽ chỉ có 2 chữ x mà thôi.
+ Các hàng sẽ có dữ liệu khác nhau, đến khi hết các tổ hợp có thể có thì có thể lặp lại cho đến khi duyệt qua hết các hàng.
+ Mọi người xem file đính kèm nhé, tôi có ví dụ minh họa.

Xin Cảm Ơn.

Hình như là file trắng trơn

 

[mapcongtu]

Xin tải lại file vì file trước bị lỗi.

Hình như là file trắng trơn

Cám ơn bạn.

 

[vanthinh3101]

Xin tải lại file vì file trước bị lỗi.

Cám ơn bạn.

Mình không rành về dạng này.
Ngồi hóng các thành viên khác giúp bạn để học hỏi thêm vậy

 

[HieuCD]

Xin tải lại file vì file trước bị lỗi.

Cám ơn bạn.

Chạy sub GPE

Sub GPE()
  Dim Arr As Variant, sR As Long, sC As Long
  Dim tArr As Variant, tR As Long, n As Long
  Dim k As Long, colStr As String, tmp As String
  Dim i As Long, j As Long
 
  k = Range("B1").Value
  sR = Range("B2").Value
  sC = Range("B3").Value
  colStr = Range("B4").Value
 
  On Error GoTo Thoat
  ReDim Arr(1 To sR, 1 To sC)
  tArr = Tohop(sC, k)
  tR = UBound(tArr)
  For i = 1 To sR
    If n < tR Then n = n + 1 Else n = 1
    tmp = tArr(n)
    For j = 1 To sC
      If Mid(tmp, j, 1) = "1" Then Arr(i, j) = "x"
    Next j
  Next i
  Range(colStr & "1").Resize(sR, sC) = Arr
  Exit Sub
Thoat:
  MsgBox ("Du lieu dau vao khong dung, Thoat chuong trinh")
End Sub
Private Function Tohop(ByVal n As Integer, ByVal k As Integer) As Variant
  Dim Arr As Variant, A As String, j As Long, p As Long, s As Long
  ReDim Arr(1 To Application.Combin(n, k))
  A = String(k, "1") & String(n - k, "0")
  p = 1:  Arr(p) = A
Trolai:
  j = InStrRev(A, "1")
  Mid(A, j, 1) = "0"
  Mid(A, j + 1, s + 1) = String(s + 1, "1")
  s = 0:    p = p + 1:    Arr(p) = A
  If InStr(j + 1, A, "0") = 0 Then
    s = n - j
    If s = k Then Tohop = Arr: Exit Function
    Mid(A, j + 1, s) = String(s, "0")
  End If
  GoTo Trolai
End Function

 

[ndu96081631]

Đây là bài toán hoán vị, có cả đống trên diễn đàn. Tìm từ khóa Permutation ---> Có không dưới 10 bài nói về vấn đề này

 

[mapcongtu]

Cảm ơn mọi người đã trả lời và chia sẽ từ khóa.

 

[mapcongtu]

Chạy sub GPE

Sub GPE()
  Dim Arr As Variant, sR As Long, sC As Long
  Dim tArr As Variant, tR As Long, n As Long
  Dim k As Long, colStr As String, tmp As String
  Dim i As Long, j As Long

  k = Range("B1").Value
  sR = Range("B2").Value
  sC = Range("B3").Value
  colStr = Range("B4").Value

  On Error GoTo Thoat
  ReDim Arr(1 To sR, 1 To sC)
  tArr = Tohop(sC, k)
  tR = UBound(tArr)
  For i = 1 To sR
    If n < tR Then n = n + 1 Else n = 1
    tmp = tArr(n)
    For j = 1 To sC
      If Mid(tmp, j, 1) = "1" Then Arr(i, j) = "x"
    Next j
  Next i
  Range(colStr & "1").Resize(sR, sC) = Arr
  Exit Sub
Thoat:
  MsgBox ("Du lieu dau vao khong dung, Thoat chuong trinh")
End Sub
Private Function Tohop(ByVal n As Integer, ByVal k As Integer) As Variant
  Dim Arr As Variant, A As String, j As Long, p As Long, s As Long
  ReDim Arr(1 To Application.Combin(n, k))
  A = String(k, "1") & String(n - k, "0")
  p = 1:  Arr(p) = A
Trolai:
  j = InStrRev(A, "1")
  Mid(A, j, 1) = "0"
  Mid(A, j + 1, s + 1) = String(s + 1, "1")
  s = 0:    p = p + 1:    Arr(p) = A
  If InStr(j + 1, A, "0") = 0 Then
    s = n - j
    If s = k Then Tohop = Arr: Exit Function
    Mid(A, j + 1, s) = String(s, "0")
  End If
  GoTo Trolai
End Function

Cảm ơn bạn nhiều.