Tạo nhiều câu khác nhau từ các cụm từ cho trước.

[Binbo2020]

4 cụm từ thì còn nghịch công thức chơi chơi được chứ 10 cụm hơn 3triệu dòng dùng làm cái gì nhỉ???
Nghịch dại vậy

 

[phạm quyên]

Bạn thử fie dưới đây. Chưa thử với số cụm từ > 8
Nhấn alt + F8 để chạy

em cảm ơn ạ, để em xem ạ

 

[HieuCD]

Tăng tốc độ xử lý, chạy code ABC

Sub ABC()
  Dim sArr(), Arr, Res(), sRow&, sCol&, i&, j&, tmp$

  sArr = Sheet1.Range("A3:A12")
  sCol = UBound(sArr)
  Arr = HoanVi(sCol)
  sRow = UBound(Arr)
  If UBound(Arr) > 1000000 Then sRow = 1000000 'gioi han 1000000 dong ket qua
  ReDim Res(1 To sRow, 1 To sCol)
  For i = 1 To sRow
    tmp = Arr(i, 1)
    For j = 1 To sCol
      Res(i, j) = sArr(AscW(Mid(tmp, j, 1)), 1)
    Next j
  Next i
  Sheet1.Range("c1").Resize(sRow, sCol) = Res
End Sub

Function HoanVi(ByVal S As Long) As Variant
  Dim Arr() As String, n&, d&, c&, i&, j&, k&, t, tmp$

  ReDim Arr(1 To WorksheetFunction.Fact(S), 1 To 1)
  For i = 1 To S
    Arr(1, 1) = Arr(1, 1) & ChrW(i)
  Next i
  n = 1
  For k = 2 To S
    d = n
    For c = k - 1 To 1 Step -1
      For i = 1 To n
        tmp = Arr(i, 1)
        Mid(tmp, c, 1) = Mid(Arr(1, 1), k, 1)
        For j = 1 To k - 1
          If j >= c Then Mid(tmp, j + 1, 1) = Mid(Arr(i, 1), j, 1)
        Next j
        Arr(i + d, 1) = tmp
      Next i
      d = d + n
    Next c
    n = n * k
  Next k
  HoanVi = Arr
  Erase Arr
End Function

 

[phạm quyên]

Tuyệt vời quá ạ, em chỉ cần nối chuỗi nữa là xong, rất cảm ơn các anh. chị đã giúp đỡ em ạ.