Ghép số lặp trên VBA (1 người xem)

  • Thread starter Thread starter qv7tb
  • Ngày gửi Ngày gửi
Liên hệ QC

Người dùng đang xem chủ đề này

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
Q

qv7tb

Sâu phải đào
Tham gia
11/1/12
Bài viết
153
Được thích
6
Nghề nghiệp
kỹ sư điện
Bài toán ghép số từ 1 đến n và ngược lại từ n về 1 lặp vị 1 đến n
Dưới đây là file ví dụ.
 

File đính kèm

Sắp xếp theo thời gian sắp xếp theo bầu chọn
qv7tb đã viết:
bác xem vi dụ đi. Em ghi ro rang vậy mà
Nhấp chuột vào đây để mở rộng...

[INFO1]Ghép số lấy từng số tại 1 theo thứ tự,hàng 1 vào cột A và lần lượt hàng 2 vào cột B, hàng 3 vào cột C[/INFO1]
Ghép từng số tại 1 có ý nghĩa ntn?
ví dụ luôn hàng 1 đi
55 22 99 thì ghép ra số ntn ?
 
Upvote 0
như 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.
 
Upvote 0
qv7tb đã viết:
như 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.
Nhấp chuột vào đây để mở rộng...
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
Túm lại, bạn viết lại kết quả ở hàng 2 ( ít số nhất) thật chính xác, chỗ nào "ngộ ngộ" thì phải giải thích cho anh em hiểu được, thí dụ những chỗ quay đầu, rồi khi quay về có chạy hết hông hay chạy nửa chừng thì "hết xăng" ( như hàng 3 sao chạy tới 59 rồi............nghỉ ???) Híc
Thân
 
Upvote 0
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
 
Upvote 0
qv7tb đã viết:
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
Nhấp chuột vào đây để mở rộng...
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ô
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
 

File đính kèm

Upvote 0
bác làm trật nữa thì ra sao. thanks bác và GPE!!
 
Upvote 0
Bạn thử với Code sau
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)
         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
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
qv7tb đã viết:
bác làm trật nữa thì ra sao. thanks bác và GPE!!
Nhấp chuột vào đây để mở rộng...

Trật nữa thì dùng code này --> Hoán vị từ 1 --> n và từ n--> về 1 :
[GPECODE=vb]
Sub GPE()
Dim Tmparr, item, tmp, Arr(1 To 1000)
Dim n As Long, j As Long, i As Long, k As Long, iR As Long
[A4:C10000].Clear
[A4:C10000].NumberFormat = "@"
For i = 1 To 3
iR = 3
Tmparr = Range(Rows(i).Cells(, 1), Rows(i).Cells(, 255).End(xlToLeft)).Value
For Each item In Tmparr
If Len(item) Then
tmp = CStr(Trim(item))
For j = 1 To Len(tmp)
n = n + 1
Arr(n) = Mid(tmp, j, 1)
Next
End If
Next
For j = 1 To n
For k = j To n
Columns(i).Cells(iR + k) = CStr(Arr(j) & Arr(k))
Next
iR = iR + n - j
Next
iR = iR + n
For j = n To 1 Step -1
For k = j To 1 Step -1
Columns(i).Cells(iR + n - k) = CStr(Arr(j) & Arr(k))
Next
iR = iR + j - 1
Next
Erase Arr : n = 0
Next
End Sub
[/GPECODE]
 
Lần chỉnh sửa cuối:
Upvote 0
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!
 
Upvote 0
qv7tb đã viết:
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!
Nhấp chuột vào đây để mở rộng...

Thử lại file này xem , thiếu trường hợp nào ?? <---- mà thôi thiếu bạn tự ngâm cứu tiếp , hoặc dùng bất kỳ code nào trên topic này để sửa theo ý bạn

ví dụ : 123 4 thì sẽ cho ra các cặp số sau : 11,12,13,14,22,23,24,33,34,44,,43,42,41,33,32,31,22,21,11
 
Lần chỉnh sửa cuối:
Upvote 0
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!
 

File đính kèm

Upvote 0
qv7tb đã viết:
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!
Nhấp chuột vào đây để mở rộng...
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 : :close_tema::close_tema::close_tema:
 
Lần chỉnh sửa cuối:
Upvote 0
hungpecc1 đã viết:
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 : :close_tema::close_tema::close_tema:
Nhấp chuột vào đây để mở rộng...


tiện bác sửa luôn đi. Em lên nhờ các bác mà.
 
Upvote 0
Cảm ơn bác. code chạy chuẩn luôn. Em vui chơi.
 
Lần chỉnh sửa cuối:
Upvote 0
concogia đã viết:
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ô
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
Nhấp chuột vào đây để mở rộng...
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
 
Upvote 0
qv7tb đã viết:
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
Nhấp chuột vào đây để mở rộng...
Híc, mình đã hỏi bạn:
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
Nhấp chuột vào đây để mở rộng...
Bạn trả lời:
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
Nhấp chuột vào đây để mở rộng...
Thôi thì
..........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ô.......
Nhấp chuột vào đây để mở rộng...
Bi giờ lòi ra:
..............còn thiếu vị trí cuối chưa lặp lại..............
Nhấp chuột vào đây để mở rộng...
Cái này mà hổng .............Híc 3 cái mới là lạ
Híc, híc, híc
Thân
 

File đính kèm

Upvote 0
em không ý kiến được nữa rồi bác viết chuẩn rồi. Cảm ơn sự nhiệt tình và tận tâm của bác. Cảm ơn forum GPE!
 
Upvote 0
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!
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
qv7tb đã viết:
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!
Nhấp chuột vào đây để mở rộng...
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.
 
Lần chỉnh sửa cuối:
Upvote 0
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 đỡ!
 
Upvote 0
qv7tb đã viết:
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 đỡ!
Nhấp chuột vào đây để mở rộng...
Xem thử file này, Click vào hình con Jerry.
 

File đính kèm

Upvote 0
Thanks bác chạy chuẩn rồi bác ah!
 
Upvote 0
Ba Tê đã viết:
Xem thử file này, Click vào hình con Jerry.
Nhấp chuột vào đây để mở rộng...
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 í
Mã: 
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
Hổng biết trúng trật nữa, nhìn chóng mặt quá
Thân
 
Upvote 0
Cảm ơn thầy concogia !
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

Bài viết mới nhất

D
in ra bị thiếu chữ (2 người xem)
Trả lời
3
Đọc
31
ptm0412
ptm0412
Momominh
Hỏi công thức tìm tuần thiếu hàng (2 người xem)
Trả lời
1
Đọc
32
hoangtuaotrang_hp_vn
H
2
EM MUỐN TẠO MA TRẬN BIẾN ĐỔI GIÁ TRỊ PHẦN TỬ NGẪU NHIÊN (1 người xem)
Trả lời
2
Đọc
27
ptm0412
ptm0412
V
  • Question Question
Tạo dữ liệu random cho từng sheet dựa theo dữ liệu có sẵn
Trả lời
2
Đọc
69
victoriabmt
V
Emyeuexcel
Cộng 4 tuần theo 1 qui luật qui định
Trả lời
34
Đọc
2K
Emyeuexcel
Emyeuexcel
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
    • Cảm ơn
2 3 4
Trả lời
394
Đọc
46K
ThanhsonLC
T
hieuxd
  • Question Question
Khi nhập dữ liệu tự động chèn thêm dòng khi số dòng trong bảng mẫu sắp hết (1 người xem)
Trả lời
24
Đọc
25K
dungpham01
D
Gà Con yêu VBA
Mở Pass file excel phiên bản .xlsx , xlsm, xlsb
Trả lời
6
Đọc
274
YêuCN
Y
S
Mở 2 cửa sổ riêng biệt
Trả lời
31
Đọc
24K
ThanhNgan240723
T
ongke0711
  • Question Question
Tra cứu thông tin mã số thuế (cập nhật lại code cũ)
    • Thích
    • Cảm ơn
    • Yêu thích
Trả lời
7
Đọc
428
ongke0711
ongke0711
vn81206
TRA CỨU MÃ SỐ THUẾ CÁ NHÂN QUA EXCEL
    • Buồn
Trả lời
57
Đọc
20K
vovietdung261016
V
PhanTuHuong
CHỌN VÀ SỬ DỤNG MÁY LỌC KHÔNG KHÍ
    • Thích
    • Cảm ơn
Trả lời
7
Đọc
1K
PhanTuHuong
PhanTuHuong
huuthang_bd
Add in SwitchSheet: Quay lại các sheet đã xem trước đó bằng phím tắt
    • Thích
    • Yêu thích
2
Trả lời
146
Đọc
42K
phong_codon
P
N
  • Question Question
Hỗ trợ tiếng việt trong macro
Trả lời
14
Đọc
596
Quang_Hải
Quang_Hải
N
Cài phần mềm đọc số ra chữ
Trả lời
2
Đọc
116
Nguyễn Duy Tuân
Nguyễn Duy Tuân
T
Em cần hỗ trợ tách nhiều file và đặt tên theo quy ước chung từ bảng 01 excel có sẳng
Trả lời
1
Đọc
101
HUONGHCKT
H
N
hàm đếm theo dòng
Trả lời
1
Đọc
87
dungpham01
D
H
LỖI KHOẢNG TRỐNG EXCEL DƯỚI THANH CÔNG CỤ
Trả lời
1
Đọc
60
ptm0412
ptm0412
A
  • Question Question
Share file copy dữ liệu từ tờ khai hải quan.
    • Thích
Trả lời
10
Đọc
987
anhdepjai
A
dungluyen2119
  • Question Question
Code VBA để tính tổng theo chiều ngang mà số cột không cố định
Trả lời
6
Đọc
323
le_vis
L
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Thời gian đếm ngược.

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom