Giúp code tách số thành nhiều cặp số không trùng nhau

[minhtuan55]

Chào cả nhà GPE. em cần 1 đoạn code tách 1 số thành nhiều cặp số không trùng
Ví dụ số 123 thì sẽ 6 trường hợp , 1234 thì có 24 trường hợp ( Giai thừa )



Sub camon()
Dim i as long
For i = 1 to 100000000000000000000
Xin chân thành cảm ơn = Xin chân thành cảm ơn + i
Next i
End sub

 

[CHAOQUAY]

@minhtuan55
Hinh như các cặp số này có tên gọi khác nữa thì phải

 

[saobekhonglac]

@minhtuan55
Hinh như các cặp số này có tên gọi khác nữa thì phải

Kiểu như hoán vị. Từ 1 dãy số sẽ có bao nhiêu số không trùng nhau. Em có file tính được có bao nhiêu số chứ không tính ra được chi tiết bao gồm những số nào.

 

[CHAOQUAY]

Kiểu như hoán vị. Từ 1 dãy số sẽ có bao nhiêu số không trùng nhau. Em có file tính được có bao nhiêu số chứ không tính ra được chi tiết bao gồm những số nào.

Hàm PERMUT có thể tính được số lượng kêt quả, nhưng mà chắc là thớt muốn liệt kê thì phải. Khổ vậy?!

 

[dovanhoc84]

Sub camon()
Dim i as long
For i = 1 to 100000000000000000000
Xin chân thành cảm ơn = Xin chân thành cảm ơn + i
Next i
End sub

Tiện có cái vòng lắp của bạn, tặng cho bạn code này:
For i = 1 to 10000000000000000000000000
If Bạn Đã Tự làm thử chưa = N then
i = i-1
Else
If Kết quả Có như mong đợi không = K then
Thử lại lần nữa
i = i-1
End if
End if


Next i

 

[minhtuan55]

Tiện có cái vòng lắp của bạn, tặng cho bạn code này:
For i = 1 to 10000000000000000000000000
If Bạn Đã Tự làm thử chưa = N then
i = i-1
Else
If Kết quả Có như mong đợi không = K then
Thử lại lần nữa
i = i-1
End if
End if


Next i

Muốn biết đán án thì đọc Code này

 

[minhtuan55]

Hàm PERMUT có thể tính được số lượng kêt quả, nhưng mà chắc là thớt muốn liệt kê thì phải. Khổ vậy?!

đúng rồi bác. phải liệt kê ra mới được anh à

 

[VetMini]

Biết viết code C/C++ thì viết đi rồi sẽ có người dịch ra VBA giùm cho.

 

[CHAOQUAY]

đúng rồi bác. phải liệt kê ra mới được anh à

code trong hình bài 6 giải quyết được chưa bạn

 

[VetMini]

code trong hình bài 6 giải quyết được chưa bạn

Muốn biết đán án thì đọc Link này
Code Xê Cọng Cọng Xịn dùng để hù dân Vê Bê A

 

[CHAOQUAY]

Muốn biết đán án thì đọc Link này
Code Xê Cọng Cọng Xịn dùng để hù dân Vê Bê A

Cám ơn bác. Hóa ra là đồ hàng mã

 

[leonguyenz]

Tôi nhớ là anh @ndu96081631 có viết 1 hàm tự tạo về yêu cầu này.
Giải thuật tôi nghĩ tới là cho 1 vòng lặp từ 1 đến giai thừa của chiều dài số (dùng WF.FACT(Len(số)), sau đó dùng vòng lặp thay thế chuỗi (Mid, Left, Right), add vào mảng (chiều dài là WF.FACT(len(số)).

 

[saobekhonglac]

Chào cả nhà GPE. em cần 1 đoạn code tách 1 số thành nhiều cặp số không trùng
Ví dụ số 123 thì sẽ 6 trường hợp , 1234 thì có 24 trường hợp ( Giai thừa )

View attachment 215114

Sub camon()
Dim i as long
For i = 1 to 100000000000000000000
Xin chân thành cảm ơn = Xin chân thành cảm ơn + i
Next i
End sub

Sử dung code bên dưới của anh NDU nha: chạy sub Main

Option Explicit
Dim Dic As Object
Sub Main()
  Dim sText As String
  Dim Arr(), Keys
  Dim t As Double, n As Long, lCount As Long
  t = Timer
  Set Dic = CreateObject("Scripting.Dictionary")
  sText = "123"  '<--- Thay giá tri khác tùy ý
  UniquePermu "", sText
  If Dic.Count Then
    Range("A:A").ClearContents
    lCount = Dic.Count
    ReDim Arr(1 To lCount, 1 To 1)
    Keys = Dic.Keys
    For n = 1 To lCount
      Arr(n, 1) = Keys(n - 1)
    Next
    Range("A1").Resize(lCount) = Arr
    MsgBox lCount & " Items found!", , "(" & Format(Timer - t, "0.000") & "s)"
  End If
End Sub
Sub UniquePermu(x As String, y As String)
  Dim i As Long, j As Long, tmp As String
  j = Len(y)
  If j < 2 Then
    tmp = x & y
    If Not Dic.Exists(tmp) Then Dic.Add tmp, ""
  Else
    For i = 1 To j
      UniquePermu x & Mid(y, i, 1), Left(y, i - 1) & Right(y, j - i)
    Next
  End If
End Sub

 

[minhtuan55]

Sử dung code bên dưới của anh NDU nha: chạy sub Main

Option Explicit
Dim Dic As Object
Sub Main()
  Dim sText As String
  Dim Arr(), Keys
  Dim t As Double, n As Long, lCount As Long
  t = Timer
  Set Dic = CreateObject("Scripting.Dictionary")
  sText = "123"  '<--- Thay giá tri khác tùy ý
  UniquePermu "", sText
  If Dic.Count Then
    Range("A:A").ClearContents
    lCount = Dic.Count
    ReDim Arr(1 To lCount, 1 To 1)
    Keys = Dic.Keys
    For n = 1 To lCount
      Arr(n, 1) = Keys(n - 1)
    Next
    Range("A1").Resize(lCount) = Arr
    MsgBox lCount & " Items found!", , "(" & Format(Timer - t, "0.000") & "s)"
  End If
End Sub
Sub UniquePermu(x As String, y As String)
  Dim i As Long, j As Long, tmp As String
  j = Len(y)
  If j < 2 Then
    tmp = x & y
    If Not Dic.Exists(tmp) Then Dic.Add tmp, ""
  Else
    For i = 1 To j
      UniquePermu x & Mid(y, i, 1), Left(y, i - 1) & Right(y, j - i)
    Next
  End If
End Sub

Mình xin trả lời ngắn gọn bằng đoạn code sau
Sub baocao()
Dim i as long
For i = 1 to 99999999999999999999999999999999999999
Chính xác = Chính xác + i
Next i
Endsub

 

[batman1]

Mình xin trả lời ngắn gọn bằng đoạn code sau
Sub baocao()
Dim i as long
For i = 1 to 99999999999999999999999999999999999999
Chính xác = Chính xác + i
Next i
Endsub

Nhưng code đấy không chạy được.
- nên khai báo tường minh mọi biến
- tên biến không được phép có dấu cách
- cái số dài kia VBA sẽ chuyển về dạng "ngắn gọn không chính xác"
- cái số "bự" kia không nhồi được vào biến LONG
- không có từ khóa Endsub
- kết quả để làm gì? Hay chạy code chỉ để xài điện nước và giết thời gian?

 

[minhtuan55]

Nhưng code đấy không chạy được.
- nên khai báo tường minh mọi biến
- tên biến không được phép có dấu cách
- cái số dài kia VBA sẽ chuyển về dạng "ngắn gọn không chính xác"
- cái số "bự" kia không nhồi được vào biến LONG
- không có từ khóa Endsub
- kết quả để làm gì? Hay chạy code chỉ để xài điện nước và giết thời gian?

Bác ơi Bác nhiều khi Góp hài xíu chứ code của e là tào lao mé lao rồi.
Gọi là Góp vui. Tại này e đang chạy ô tô kẹt xe ở Trường Chinh nên ngồi rãnh góp tí văn nghệ