Sort chuỗi theo thứ tự

Liên hệ QC

Miccpro

Thành viên thường trực
Tham gia
9/12/10
Bài viết
236
Được thích
10
Em có hàm này của thầy ndu96081631 về việc sắp xếp chuỗi chữ số theo thứ tự tăng hoặc giảm dần

Mã:
Function StrSort(ByVal Text As String, ByVal Delimiter As String, Optional ByVal Order As Boolean = False) As String
  Dim aTmp, item, strDes As String
  Dim n As Long
  On Error Resume Next
  aTmp = Split(Text, Delimiter)
  ReDim Arr(1 To 1)
  For Each item In aTmp
    n = CLng(Trim(item))
    If n > DoiChuThanhSo(UBound(Arr)) Then ReDim Preserve Arr(1 To n)
    Arr(n) = Arr(n) & " " & IIf(Order, StrReverse(n), n)
  Next
  strDes = WorksheetFunction.Trim(Join(Arr, " "))
  If Order Then strDes = StrReverse(strDes)
  StrSort = Replace(strDes, " ", Delimiter)
End Function
Giờ em muốn một hàm tương tự như hàm trên nhưng sắp xếp theo chữ cái (Tên cột trong excel), ví dụ:
Chuỗi: A;G;C;BF;AA thì thành: A;C;G;AA;BF
Em xin cảm ơn!
 
Em có hàm này của thầy ndu96081631 về việc sắp xếp chuỗi chữ số theo thứ tự tăng hoặc giảm dần

Mã:
Function StrSort(ByVal Text As String, ByVal Delimiter As String, Optional ByVal Order As Boolean = False) As String
  Dim aTmp, item, strDes As String
  Dim n As Long
  On Error Resume Next
  aTmp = Split(Text, Delimiter)
  ReDim Arr(1 To 1)
  For Each item In aTmp
    n = CLng(Trim(item))
    If n > DoiChuThanhSo(UBound(Arr)) Then ReDim Preserve Arr(1 To n)
    Arr(n) = Arr(n) & " " & IIf(Order, StrReverse(n), n)
  Next
  strDes = WorksheetFunction.Trim(Join(Arr, " "))
  If Order Then strDes = StrReverse(strDes)
  StrSort = Replace(strDes, " ", Delimiter)
End Function
Giờ em muốn một hàm tương tự như hàm trên nhưng sắp xếp theo chữ cái (Tên cột trong excel), ví dụ:
Chuỗi: A;G;C;BF;AA thì thành: A;C;G;AA;BF
Em xin cảm ơn!
Thấy bài này cũng hay hay. Nên sửa tiêu đề "Sort chuỗi theo thứ tự tên cột Excel"
Viết thí đại 1 hàm, chờ xem cách khác để học hỏi thêm.
 

File đính kèm

  • Sort_TenCot.xlsb
    15.8 KB · Đọc: 23
Upvote 0
Tôi có 2 cách để bạn kiểm thử và sử dụng:


Lưu ý: Hàm HeaderSort1 sẽ xảy ra lỗi nếu Trang tính ẩn cột, cũng như có giới hạn và chậm

-------------------------------
PHP:
Option Explicit
Private Sub HeaderSort1_test()
  Dim t As Double: t = Timer
  Debug.Print HeaderSort1("D,A,C,B", True)
  Debug.Print Round(Timer - t, 5)
End Sub
Public Function HeaderSort1(ByVal InputText As String, _
                    Optional ByVal ZtoA As Boolean = False) As String
  Dim Tmp, J As Integer, C As Long, D As String
  HeaderSort1 = Replace(InputText, " ", "")
  For J = 1 To 10
    D = Mid(HeaderSort1, J, 1)
    If Not D Like "[A-z]" Then GoTo N
  Next
  Exit Function
N: ReDim Arr(0 To 16384)
  Tmp = Split(HeaderSort1, D)
  For J = 0 To UBound(Tmp)
    C = Columns(Tmp(J)).Column
    Arr(Abs(16384 * ZtoA + C)) = Tmp(J)
  Next J
  HeaderSort1 = Replace(Trim(Join(Arr, " ")), " ", D)
End Function
''/////////////////////////////////////////////////////////////
Private Sub HeaderSort2_test()
  Dim t As Double: t = Timer
  Debug.Print HeaderSort2("D,A,C,B", True)
  Debug.Print Round(Timer - t, 5)
End Sub
Public Function HeaderSort2(ByRef InputText, _
                       Optional ZtoA As Boolean = False) As String
  Dim SP() As String, LB1%, UB1&, i&, J&, t As String, D As String
  HeaderSort2 = Replace(InputText, " ", "")
  For i = 1 To 10
    D = Mid(HeaderSort2, i, 1)
    If Not D Like "[A-z]" Then GoTo N
  Next
  Exit Function
N: SP = Split(HeaderSort2, D)
  LB1 = LBound(SP): UB1 = UBound(SP)
  For i = LB1 To UB1 - 1: For J = i + 1 To UB1
      t = VBA.StrComp(SP(i), SP(J), 1)
      If (Not ZtoA And t = 1) Or (ZtoA And t = -1) Then
        t = SP(J): SP(J) = SP(i): SP(i) = t
      End If
  Next J, i
  HeaderSort2 = Join(SP, D)
End Function
 
Lần chỉnh sửa cuối:
Upvote 0
Thấy bài này cũng hay hay. Nên sửa tiêu đề "Sort chuỗi theo thứ tự tên cột Excel"
Viết thí đại 1 hàm, chờ xem cách khác để học hỏi thêm.
Loại đề bài chữa cháy này thì cứ ciode ba đồng bốn cọc, chạy ra kết quả à xong.
Thực sự nó chả có gì để học hỏi cả.
Nếu có thể thì sửa:
C = Range("$" & Trim(Tmp(J)) & "$1").Column
thành
C = Cells(1, Trim(Tmp(J))).Column
trông dễ hiểu hơn.

Nếu là bài toán sử dụng nhiều lần thì mới xứng đáng phân tích hiệu quả của nó.
Điển hình, giải thuật này bạn sort theo chỉ số. Giản dị và hiệu quả nhưng nếu chỉ có chừng chục chuỗi mà bạn phải dựng cái mảng tổ bố và duyệt nó thì hơi phí.
Nếu số chuỗi nhỏ thì dùng phương pháp sort thông thường hiệu quả hơn.

Số chuỗi nhỏ và dùng kỹ thuật sort khác:
Mẹo nhỏ để so sánh chuỗi kiểu này (bề dài chuỗi là điều kiện đầu tiên)
Cộng độ dài chuỗi vào đầu mỗi chuỗi. "1B" như vậy sẽ đi trước "2AA".
Sau khi join thì thay thế "1", "2", "3" bằng ""
(hoặc cộng số Chr(255) vào đầu chuỗi, sau khi join thì chỉ cần thay 1 lần)
 
Upvote 0
Web KT

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

Back
Top Bottom