bác xem vi dụ đi. Em ghi ro rang vậy màchẳng hiểu yêu cầu của bạn luôn
bác xem vi dụ đi. Em ghi ro rang vậy mà
Ok, hổng hiểu luônnhư thế này bác ah ví dụ 50148 75243(từ 1đến n ở đây có 8 số có nghĩ n=8) như vậy ghép số 1 đến n và ngược lại n đến 1 và lặp tai các số đã qua. ví dụ hàng 1: 55(lặp tại 1 là 5, tương tự lặp tại 2 là 0 sẽ là 00),50,51,54,58,5,57,55,52,54,54,00,01,04,08...
bài toán là vậy đó bác.
Lỡ theo tới đây rồi thì viết luôn, viết giống như kết quả của bạn thôi, chứ vẫn chưa hiểu chi môtrước khi chạy đã lặp lại tại đó lần đi rồi bác. bác để y kỹ coi em mỏi tay quá quên 09 cuối cùng hàng 3
Sub Ghep()
Dim Arr, sArr, ArrStr(1 To 3, 1 To 1), ResArr
Dim Str As String
Dim n As Long
Dim i As Long
Dim j As Long
Dim t As Long
Dim k As Long
Arr = Range("B1:B3").Resize(, Range([B3], [B3].End(xlToRight)).Columns.Count)
ReDim sArr(1 To 3, 1 To UBound(Arr, 2))
ReDim ResArr(1 To 1, 1 To 1)
Columns("K:M").ClearContents
For i = 1 To 3
For j = 1 To UBound(Arr, 2)
Str = Str & Arr(i, j)
Next
For t = 1 To Len(Str)
For k = 1 To Len(Str)
n = n + 1
ReDim Preserve ResArr(1 To 1, 1 To n)
ResArr(1, n) = Mid(Str, t, 1) & Mid(Str, k, 1)
Next
Next
Cells(4, i + 10).Resize(n, 1) = Application.WorksheetFunction.Transpose(ResArr)
n = 0
Str = ""
Next
End Sub
bác làm trật nữa thì ra sao. thanks bác và GPE!!
code của bác cho chạy nhanh tý đụợc không em đợi mỏi mắt quá. hai nữa bỏ nhiều trường hợp quá. tại 1 đến n thì lặp lại cho em cái. thanks bác!
Mươn code của bạn dn46 bài #10 :các cho em quá giang cho nửa con đường rồi cho em qua tiếp. Bài toán ghép số lần này yêu cầu vẫn vậy thôi. nhưng bỏ trường hợp đảo ra(ví dụ như sau 456789==>>cho ra 44,45,46,47,48,49,55,56,57,58,59,66,67,68,69,77,78,79,88,89,99)
dưới đây là file minh họa
Cảm ơn a/e GPE!
Sub Ghep()Dim Arr, sArr, ArrStr(1 To 3, 1 To 1), ResArr
Dim Str As String
Dim n As Long
Dim i As Long
Dim j As Long
Dim t As Long
Dim k As Long
Arr = Range("B1:B3").Resize(, Range([B3], [B3].End(xlToRight)).Columns.Count)
ReDim sArr(1 To 3, 1 To UBound(Arr, 2))
ReDim ResArr(1 To 1, 1 To 1)
Columns("K:M").ClearContents
For i = 1 To 3
For j = 1 To UBound(Arr, 2)
Str = Str & Arr(i, j)
Next
For t = 1 To Len(Str)
[B][SIZE=3][COLOR=#ff0000] For k = 1 To Len(Str)[/COLOR][/SIZE][/B]
n = n + 1
ReDim Preserve ResArr(1 To 1, 1 To n)
ResArr(1, n) = Mid(Str, t, 1) & Mid(Str, k, 1)
Next
Next
Cells(4, i + 10).Resize(n, 1) = Application.WorksheetFunction.Transpose(ResArr)
n = 0
Str = ""
Next
End Sub
Mươn code của bạn dn46 bài #10 :
Mã:Sub Ghep()Dim Arr, sArr, ArrStr(1 To 3, 1 To 1), ResArr Dim Str As String Dim n As Long Dim i As Long Dim j As Long Dim t As Long Dim k As Long Arr = Range("B1:B3").Resize(, Range([B3], [B3].End(xlToRight)).Columns.Count) ReDim sArr(1 To 3, 1 To UBound(Arr, 2)) ReDim ResArr(1 To 1, 1 To 1) Columns("K:M").ClearContents For i = 1 To 3 For j = 1 To UBound(Arr, 2) Str = Str & Arr(i, j) Next For t = 1 To Len(Str) [B][SIZE=3][COLOR=#ff0000] For k = 1 To Len(Str)[/COLOR][/SIZE][/B] n = n + 1 ReDim Preserve ResArr(1 To 1, 1 To n) ResArr(1, n) = Mid(Str, t, 1) & Mid(Str, k, 1) Next Next Cells(4, i + 10).Resize(n, 1) = Application.WorksheetFunction.Transpose(ResArr) n = 0 Str = "" Next End Sub
Bạn sửa lại dòng code tô màu đỏ trong code trên :![]()
tiện bác sửa luôn đi. Em lên nhờ các bác mà.
Thân gửi bác có 1 lỗi em phát ra thuật toán còn thiếu vị trí cuối chưa lặp lại(ví dụ 1234==>>11,12,13,14,22,23,24,33,34,44,43,42,41,32,31,21) và quay lại rồi bác xem sửa lại dùm em cái code cho phù hợp. thanks bácLỡ theo tới đây rồi thì viết luôn, viết giống như kết quả của bạn thôi, chứ vẫn chưa hiểu chi mô
Bạn phang vô đầu con mèo một phát, kết quả tử [D4], kiểm tra giúp mình, trúng thì tốt, trật thì nhờ...........Ba Tê viết giúp
Thân
Híc, mình đã hỏi bạn:Thân gửi bác có 1 lỗi em phát ra thuật toán còn thiếu vị trí cuối chưa lặp lại(ví dụ 1234==>>11,12,13,14,22,23,24,33,34,44,43,42,41,32,31,21) và quay lại rồi bác xem sửa lại dùm em cái code cho phù hợp. thanks bác
Bạn trả lời:Ok, hổng hiểu luôn
Nhìn ví dụ trong bài, ở hàng 2, kết quả : 22, 27, 22, 26.............cái này hiểu
Tới cuối: ...44, 40 đáng lý ra số kế tiếp phải là 00 chứ ( vì chưa lặp số cuối) sao lại là 04 ( bắt đầu chạy ngược lại)
Còn lúc chạy ngược lại thì chạy kiểu nào mà .........lạ vậy
Thôi thìtrước khi chạy đã lặp lại tại đó lần đi rồi bác. bác để y kỹ coi em mỏi tay quá quên 09 cuối cùng hàng 3
Bi giờ lòi ra:..........Lỡ theo tới đây rồi thì viết luôn, viết giống như kết quả của bạn thôi, chứ vẫn chưa hiểu chi mô.......
Cái này mà hổng .............Híc 3 cái mới là lạ..............còn thiếu vị trí cuối chưa lặp lại..............
Xem cách ghép từ trái qua phải còn hiểu, kết quả của bạn từ phải sang trái sao lạ quá, giải thích rõ lại đi.sau tất cả các bài viết và qua trình kiểm nghiệm em thấy bài toán em đưa ra còn nhiều thiếu sót cho công việc hiện tại đành lên diễn đàn nhờ các bậc đàn anh chỉ giúp. Với bài toán trên là hoán vị thì bài toán này là tổ hợp chập 2 của n số.
bài toán thuật đảo như sau: Nhờ các cao thủ viết code tổ hợp chập 2 của n số từ 1 tới n và ngược lại từ n về 1 (không có trường hợp nào lặp lại tại điểm đó) thuộc hàng 1 cho kết quả ra cột A tương tự như thế ta làm với hàng 2 cho kết quả cột B... hàng n cho kết quả cột thứ n.
sau đây em gửi file đính kèm(chỉ code chạy như file là ok rồi) hjhj
Thanks các anh chị và các bạn GPE!
Xem thử file này, Click vào hình con Jerry.có nghĩa là tổ hợp chập 2 của n số từ trái qua phải và ngược lại từ phải qua trái.
ví dụ như sau: hàng 1 có các số sau:123456 ghép tổ hợp chập 2 của 6 số từ trái qua phải :12,13,14,15,16,23,24,25,26,34,35,36,45,46,56 và ngược lại từ phải qua trái cho ra :65,64,63,62,61,54,53,52,51,43,42,41,32,31,21:
tóm lại kêt quả tổ hợp chập 2 của 6 số từ trái qua phải và ngược lại từ phải qua trái cho ra:
12,13,14,15,16,23,24,25,26,34,35,36,45,46,56,65,64,63,62,61,54,53,52,51,43,42,41,32,31,21
em chỉ hiểu sao giải thích vậy.
cảm ơn bác quan tâm. giúp đỡ!
Hình như nếu ta gom thằng chạy về chung với thằng chạy đi sẽ bới được một vòng "Pho nếch" hay sao íXem thử file này, Click vào hình con Jerry.
Public Sub JerryA()
Dim iTong, TemNguoc, sArr(), Tem As Variant, dArr(), R As Long, K As Long, kK As Long, L As Long, C As Long, I As Long, J As Long, N As Long, X As Long, iMax As Long
sArr = [A1].CurrentRegion.Value
ReDim dArr(1 To 65000, 1 To UBound(sArr, 1))
For I = 1 To UBound(sArr, 1)
For J = 1 To UBound(sArr, 2)
Tem = Tem & sArr(I, J)
Next J
TemNguoc = StrReverse(Tem)
L = Len(Tem)
iTong = Application.WorksheetFunction.Combin(L, 2)
iMax = IIf(iMax > iTong * 2, iMax, iTong * 2)
For N = 1 To L - 1
For X = N + 1 To L
K = K + 1
dArr(K, I) = Mid(Tem, N, 1) & Mid(Tem, X, 1)
kK = iTong + K
dArr(kK, I) = Mid(TemNguoc, N, 1) & Mid(TemNguoc, X, 1)
Next X
Next N
K = 0: Tem = ""
Next I
[N5].Resize(65000, UBound(sArr, 1)).ClearContents
[N5].Resize(iMax, UBound(sArr, 1)).Value = dArr
End Sub