Nhờ code sắp xếp

quynhnamimex · 8/12/21

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

Cám ơn các thầy và các anh, chị nhiều

Hai Lúa Miền Tây · 8/12/21

quynhnamimex đã viết:
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

View attachment 270093

Cám ơn các thầy và các anh, chị nhiều

Bạn gửi file giả lập gần giống với file thực tế của bạn rồi gửi lên đây mọi người xem thử nhé.

truongvu317 · 8/12/21

Bạn đã có ý tưởng gì chưa?

Hai Lúa Miền Tây · 8/12/21

truongvu317 đã viết:
Bạn đã có ý tưởng gì chưa?

Ý 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

quynhnamimex · 8/12/21

truongvu317 đã viết:
Bạn đã có ý tưởng gì chưa?

ý tưởng mình là tách 3 số + 2 số, sau đó ưu tiên sort 2 số

Hai Lúa Miền Tây · 8/12/21

quynhnamimex đã viết:
ý tưởng mình là tách 3 số + 2 số, sau đó ưu tiên sort 2 số

Tôi đã làm theo ý này ở bài trên rồi mà bạn?

quynhnamimex · 8/12/21

Hai Lúa Miền Tây đã viết:
Tôi đã làm theo ý này ở bài trên rồi mà bạn?

Thầy quá pro rồi. Cám ơn thầy nhiều

truongvu317 · 8/12/21

quynhnamimex đã viết:
ý tưởng mình là tách 3 số + 2 số, sau đó ưu tiên sort 2 số

Đúng rồi, tách ra và ưu tiên sort, bạn làm được đoạn nào rùi

SA_DQ · 8/12/21

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!

VetMini · 8/12/21

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!

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.

batman1 · 8/12/21

Nếu là công thức thì ví dụ công thức cho E8, kết thú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)

huuthang_bd · 9/12/21

batman1 đã viết:
Nếu là công thức thì ví dụ công thức cho E8, kết thú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ư 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)

bebo021999 · 9/12/21

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

snow25 · 9/12/21

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

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.

bebo021999 · 9/12/21

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.

Thử đi nhé. Vòng lặp (viết tắt là "VL")

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.

Nhattanktnn · 9/12/21

bebo021999 đã viết:
Thử đi nhé. Vòng lặp (viết tắt là "VL")
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.

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

VetMini · 9/12/21

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.

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.

quynhnamimex · 10/12/21

truongvu317 đã viết:
Đúng rồi, tách ra và ưu tiên sort, bạn làm được đoạn nào rùi

mình làm dc rồi, cám ơn bạn nhe

concogia · 10/12/21

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

Á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

VetMini · 12/12/21

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

Nhờ code sắp xếp

Thành viên mới

❆❆❆❆❆❆❆❆

Thành viên tích cực

❆❆❆❆❆❆❆❆

Thành viên mới

❆❆❆❆❆❆❆❆

Thành viên mới

Thành viên tích cực

/(hông là gì!

Ăn cùng góc phố

Thành viên gạo cội

Chuyên gia GPE

Thành viên gạo cội

Thành viên gạo cội

Thành viên gạo cội

Thành viên gắn bó

Ăn cùng góc phố

Thành viên mới

Gội rồi mới Cạo

Ăn cùng góc phố