Nhờ code sắp xếp

Liên hệ QC
Q

quynhnamimex

Thành viên mới
Tham gia
8/1/09
Bài viết
18
Được thích
7
Kính chào các thầy và anh, chị

Nhờ các thầy viết dùm code sắp xếp như trong hình

1638949212440.png

Cám ơn các thầy và các anh, chị nhiều
 
Sắp xếp theo thời gian sắp xếp theo bầu chọn
Upvote 0
truongvu317 đã viết:
Bạn đã có ý tưởng gì chưa?
Nhấp chuột vào đây để mở rộng...
Ý tưởng thì có rồi ví dụ như sau:

Mã: 
Sub SapXep_HLMT()
    Dim cnn As String
    cnn = "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=""Excel 12.0 Xml;HDR=No"";Data Source=" & ThisWorkbook.FullName
    With CreateObject("ADODB.Recordset")
        .Open ("Select F1 From [D8:D18] Order By Val(Right(F1,2)),Val(Left(F1,3))"), cnn
        Range("F8").CopyFromRecordset .DataSource
    End With
End Sub
 
Upvote 0
Xài hàm MOD(100,XXXAB) => AB & đem số này nhân với 1000 & cọng với XXX
Xếp cột phụ này là OK!
 
Upvote 0
SA_DQ đã viết:
Xài hàm MOD(100,XXXAB) => AB & đem số này nhân với 1000 & cọng với XXX
Xếp cột phụ này là OK!
Nhấp chuột vào đây để mở rộng...
Tại thớt thích code cho pờ-rồ chứ bài này các ô có độ dài bằng nhau.
Tôi thì cứ text-to-columns (fixed width) ra 2 cột rồi sort cho nó chân lấm tay bùn một chút.
 
Upvote 0
Nếu là công thức thì ví dụ công thức cho E8, kết thúc bằng Ctrl + Shift + Enter
Mã: 
=RIGHT(SMALL(--(MID(D$8:D$18 & D$8:D$18,4,5) & D$8:D$18),ROWS(A$1:A1)),5)
 
Upvote 0
batman1 đã viết:
Nếu là công thức thì ví dụ công thức cho E8, kết thúc bằng Ctrl + Shift + Enter
Mã: 
=RIGHT(SMALL(--(MID(D$8:D$18 & D$8:D$18,4,5) & D$8:D$18),ROWS(A$1:A1)),5)
Nhấp chuột vào đây để mở rộng...
Như vầy luôn cũng được.
Mã: 
=RIGHT(SMALL(--MID(D$8:D$18 & D$8:D$18,4,7),ROWS(A$1:A1)),5)
 
Upvote 0
Nếu muốn VBA thì dùng tạm củ chuối này:
PHP: 
Sub sapxep()
Application.ScreenUpdating = False
Dim rng As Range
Dim Arr As Variant
Dim temp, Lr, i, j As Long
Lr = Cells(Rows.Count, "D").End(xlUp).Row
Set rng = Range("D8:D" & Lr)
ReDim Arr(1 To Lr - 7, 1 To 1)
For i = 8 To Lr
    Arr(i - 7, 1) = Right(Cells(i, "D"), 2) * 1000 + Left(Cells(i, "D"), 3)
Next
 
    For i = 1 To Lr - 7
        For j = i + 1 To Lr - 7
            If Arr(i, 1) > Arr(j, 1) Then
                temp = Arr(j, 1)
                Arr(j, 1) = Arr(i, 1)
                Arr(i, 1) = temp
            End If
        Next
    Next
    For i = 1 To Lr - 7
        temp = Arr(i, 1)
        Arr(i, 1) = Right(temp, 3) & Left(temp, 2)
    Next
    Range("D8").Resize(Lr - 7, 1).Value = Arr
Application.ScreenUpdating = True
End Sub
 
Upvote 0
bebo021999 đã viết:
Nếu muốn VBA thì dùng tạm củ chuối này:
PHP: 
Sub sapxep()
Application.ScreenUpdating = False
Dim rng As Range
Dim Arr As Variant
Dim temp, Lr, i, j As Long
Lr = Cells(Rows.Count, "D").End(xlUp).Row
Set rng = Range("D8:D" & Lr)
ReDim Arr(1 To Lr - 7, 1 To 1)
For i = 8 To Lr
    Arr(i - 7, 1) = Right(Cells(i, "D"), 2) * 1000 + Left(Cells(i, "D"), 3)
Next
 
    For i = 1 To Lr - 7
        For j = i + 1 To Lr - 7
            If Arr(i, 1) > Arr(j, 1) Then
                temp = Arr(j, 1)
                Arr(j, 1) = Arr(i, 1)
                Arr(i, 1) = temp
            End If
        Next
    Next
    For i = 1 To Lr - 7
        temp = Arr(i, 1)
        Arr(i, 1) = Right(temp, 3) & Left(temp, 2)
    Next
    Range("D8").Resize(Lr - 7, 1).Value = Arr
Application.ScreenUpdating = True
End Sub
Nhấp chuột vào đây để mở rộng...
Sao không kết hợp cái vòng lặp cuối vào trong vòng for trên nhỉ bạn.Tìm được giá trị nào tách luôn ra đỡ phải thêm cái vòng lặp cuối.
 
Upvote 0
snow25 đã viết:
Sao không kết hợp cái vòng lặp cuối vào trong vòng for trên nhỉ bạn.Tìm được giá trị nào tách luôn ra đỡ phải thêm cái vòng lặp cuối.
Nhấp chuột vào đây để mở rộng...
Thử đi nhé. Vòng lặp (viết tắt là "VL") o_O
VL1 để dịch từ 00119 thành 19001
VL2 để so sánh giá trị lần lựơt từng ô với lần lượt từng ô còn lại, kết thúc VL là giá trị MIN nằm trên cùng.
VL3 dùng để đảo vị trí từng thành phần của mảng tạo ra từ VL2, VD: 19001 thành 00119
Nếu kết hợp thì không được vì VL2 phải kết thúc, mới bắt đầu VL3 được.
 
Upvote 0
bebo021999 đã viết:
Thử đi nhé. Vòng lặp (viết tắt là "VL") o_O
VL1 để dịch từ 00119 thành 19001
VL2 để so sánh giá trị lần lựơt từng ô với lần lượt từng ô còn lại, kết thúc VL là giá trị MIN nằm trên cùng.
VL3 dùng để đảo vị trí từng thành phần của mảng tạo ra từ VL2, VD: 19001 thành 00119
Nếu kết hợp thì không được vì VL2 phải kết thúc, mới bắt đầu VL3 được.
Nhấp chuột vào đây để mở rộng...
Em thấy code thế này cũng được:
Mã: 
Sub SapXep1()
Dim Arr(), Tmp As Long, I As Long, J As Long
With Sheets("Sheet1")
    Arr = .Range("D8:D" & .Cells(Rows.Count, "D").End(xlUp).Row).Value
    For I = 1 To UBound(Arr)
        For J = I + 1 To UBound(Arr)
            If Val(Right(Arr(J, 1), 2) & Left(Arr(J, 1), 3)) < Val(Right(Arr(I, 1), 2) & Left(Arr(I, 1), 3)) Then
                Tmp = Arr(I, 1)
                Arr(I, 1) = Arr(J, 1)
                Arr(J, 1) = Tmp
            End If
        Next
    Next
    .Range("G8").Resize(UBound(Arr)) = Arr
End With
End Sub
 
Upvote 0
bebo021999 đã viết:
...Nếu kết hợp thì không được vì VL2 phải kết thúc, mới bắt đầu VL3 được.
Nhấp chuột vào đây để mở rộng...
Lúc VL2 kết thúc thì Arr(i, 1) đã ngồi yên vị trí rồi. Vòng tới của VL1, thì code chỉ sort kể từ i+1

For i = 1 To Lr - 7
For j = i + 1 To Lr - 7
If Arr(i, 1) > Arr(j, 1) Then
temp = Arr(j, 1)
Arr(j, 1) = Arr(i, 1)
Arr(i, 1) = temp
End If
Next
Arr(i, 1) = Right(Arr(i, 1)) & Left(Arr(i, 1))
Next

Code này dùng rất nhiều biểu thức Lr -7. Chẳng những rườm rà mà còn khó hiểu. Đặt quách một biến soDong = Lr-7 cho nó gọn.
 
Upvote 0
bebo021999 đã viết:
Nếu muốn VBA thì dùng tạm củ chuối này:
PHP: 
Sub sapxep()
Application.ScreenUpdating = False
Dim rng As Range
Dim Arr As Variant
Dim temp, Lr, i, j As Long
Lr = Cells(Rows.Count, "D").End(xlUp).Row
Set rng = Range("D8:D" & Lr)
ReDim Arr(1 To Lr - 7, 1 To 1)
For i = 8 To Lr
    Arr(i - 7, 1) = Right(Cells(i, "D"), 2) * 1000 + Left(Cells(i, "D"), 3)
Next
 
    For i = 1 To Lr - 7
        For j = i + 1 To Lr - 7
            If Arr(i, 1) > Arr(j, 1) Then
                temp = Arr(j, 1)
                Arr(j, 1) = Arr(i, 1)
                Arr(i, 1) = temp
            End If
        Next
    Next
    For i = 1 To Lr - 7
        temp = Arr(i, 1)
        Arr(i, 1) = Right(temp, 3) & Left(temp, 2)
    Next
    Range("D8").Resize(Lr - 7, 1).Value = Arr
Application.ScreenUpdating = True
End Sub
Nhấp chuột vào đây để mở rộng...
Ái chà chà, lúc này Bí Bo viết dữ hé. Bài này mình đố Bí Bo viết chỉ xử dụng 1 vòng lặp
Trả lời được ....lên bác Sa nhậu
Thân
 
Upvote 0
Cái vòng lặp VL2 của người ta là code sắp xếp theo bọt nổi (bubble sort). Nếu gọi một hàm sắp xếp ngay từ đầu thì đâu cần vòng lặp này.

Vấn đề là khi giảm số vòng lặp thì có giảm số lần lặp lại hay không, và có phải hy sinh cái gì mới quan trọng. Chứ theo nguyên tắc lập trình thì số vòng lặp đâu có quan trọng. Để tâm sức tính toán lô gic tốt hơn.

Điển hình code duyệt mảng 2 chiều:

' hai vòng lặp lồng nhau. Sô lần lặp lại code là soDong*soCot
For i = 1 To soDong
For j = 1 To soCot
a(ị, j) ...
Next j
Next i

' 1 vòng lặp. Số lần lặp lại code là soDong*soCot
For i = 1 To soDong * soCot
a((i-1) \ soDong + 1, Applcation.Max(i Mod soCot, soCot)) ...
Next i
' code vừa khó hiểu, thực tế lại tính toán nhiều hơn
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

NguyenthiH
Công thức tạo số phiếu xuất.
Trả lời
10
Đọc
193
ptm0412
ptm0412
C
Xin công thức xếp loại có điều kiện.
Trả lời
4
Đọc
152
Hoàng Tuấn 868
H
noisy
Nhờ hỗ trợ tạo thống kê
Trả lời
5
Đọc
142
tranhungdao12a3
T
N
Chuyển dữ liệu tất cả ở các dòng thành 1 cột
Trả lời
4
Đọc
104
tranhungdao12a3
T
trungvinh252
Xuất ngày tháng gần nhất được đánh dấu. Xin giúp đỡ ạ.
Trả lời
0
Đọc
71
trungvinh252
trungvinh252
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

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

Back
Top Bottom