Sort số trong Cell (1 người xem)

[be_09]

khanghycfc là thành viên mới tham gia, cần lấy giá trị từ cột A sang cột B rồi sắp xếp các số trong Cell theo thứ tự giãm dần or tăng dần, Link bài viết tại đây:

http://www.giaiphapexcel.com/forum/...g-tìm-cã-tháng-trên-mạng-mà-không-có-lời-giải.

Do chưa đọc kỹ nội quy nên việc đăng bài vi phạm nội tại III quy định về tiêu đề bài viết, đọc lại nội quy ở Link sau:

http://www.giaiphapexcel.com/forum/showthread.php?76052&tabid=143

Trả lời: Để sắp xếp các số trong Cell B2 (lấy giá trị từ A2) theo thứ tự tăng dần dùng hàm sau:

=TEXT(SUM(SMALL(--MID(A2,ROW(INDIRECT("1:"&LEN(A2))),1),ROW(INDIRECT("1:"&LEN(A2))))*10^(LEN(A2)-ROW(INDIRECT("1:"&LEN(A2))))),REPT("0",LEN(A2)))

Hàm mãng, khi sử dụng nhấn Ctrl+Shift+Enter

Hoặc dùng hàm tự tạo:

Function SortCell(sStr As String)
     SortCell = Join(Evaluate("transpose(if(row(1:" & Len(sStr) & "),small(--mid(""" _
& sStr & """,row(1:" & Len(sStr) & "),1),row(1:" & Len(sStr) & "))))"), "")
End Function

Tại B2 dùng hàm

=SortCell(A2)

Đề nghị Admin sửa lại tiêu đề là Sort (tôi gõ là Sort nhưng sau khi gửi bài thì nó lại chuyển sang chữ khác là sao???)

 

[Hoàng Nhật Phương]

Xin chào be09 cùng các bạn,

Oanh Thơ cũng đang gặp phải 1 vấn đề về dạng bài toán sắp xếp chuỗi số trong 1 ô,cụ thể:
Ví vùng A1:A123 Oanh Thơ nhập 1 chuỗi số có dạng như sau:

12&123&34&13&66

làm thế nào để kết quả các chuỗi số nhập trong vùng A1:A123 trả về được sắp xếp theo thứ tự từ nhở đến lớn như bên dưới.

=> 12&13&34&66&123

Cụ thể dãy số này Oanh Thơ đã có 1 bài toán và file đính kèm ở đây ạ:

https://www.giaiphapexcel.com/forum/showthread.php?121612-Lọc-duy-nhất&p=761165#post761165

Kính mong nhận được sự giúp đỡ của các bạn.
Trân trọng cảm ơn.
Oanh Thơ

 

[befaint]

Xin chào be09 cùng các bạn,

Oanh Thơ cũng đang gặp phải 1 vấn đề về dạng bài toán sắp xếp chuỗi số trong 1 ô,cụ thể:
Ví vùng A1:A123 Oanh Thơ nhập 1 chuỗi số có dạng như sau:

12&123&34&13&66

làm thế nào để kết quả các chuỗi số nhập trong vùng A1:A123 trả về được sắp xếp theo thứ tự từ nhở đến lớn như bên dưới.

=> 12&13&34&66&123

Cụ thể dãy số này Oanh Thơ đã có 1 bài toán và file đính kèm ở đây ạ:

https://www.giaiphapexcel.com/forum/showthread.php?121612-Lọc-duy-nhất&p=761165#post761165

Kính mong nhận được sự giúp đỡ của các bạn.
Trân trọng cảm ơn.
Oanh Thơ

Function:

Function fRNG(rng As Range) As Variant
Dim Dic As Object: Set Dic = CreateObject("Scripting.Dictionary")
Dim tmp As Variant, r As Long, z As Long, c As Long, KQ() As Variant, arr As Variant, T
tmp = rng.Value: z = UBound(tmp, 2)
For r = 1 To UBound(tmp, 1)
    For c = 1 To z
        If tmp(r, c) <> "" And Not Dic.Exists(tmp(r, c)) Then Dic.Add tmp(r, c), ""
    Next c
Next r
Erase tmp: tmp = Dic.Keys
z = UBound(tmp)
ReDim KQ(1 To z + 1, 0)
For r = 0 To z
    T = tmp(r)
    If IsNumeric(T) Then
        KQ(r + 1, 0) = T
    Else
        arr = Split(Replace(T, " ", ""), "&")
        KQ(r + 1, 0) = Join(sMinMax(arr), " & ")
    End If
Next r
fRNG = KQ
End Function
'--------------------------------------------------------
Public Function sMinMax(arr As Variant) As Variant
Dim tmp As Variant, i As Long, j As Long, z As Long
If Not IsArray(arr) Then Exit Function
z = UBound(arr)
For i = LBound(arr) To UBound(arr)
    For j = i + 1 To UBound(arr)
      If CLng(arr(i)) > CLng(arr(j)) Then
        tmp = arr(j)
        arr(j) = arr(i)
        arr(i) = tmp
      End If
    Next j
Next i
sMinMax = arr
End Function

Sub:

Sub Main()
Dim rng As Range, z As Long, tmp As Variant
z = ActiveCell.SpecialCells(xlLastCell).Row
Set rng = Range("C5:I" & z)
tmp = fRNG(rng)
Range("K5").Resize(UBound(tmp, 1), 1) = tmp
End Sub

 

[Hoàng Nhật Phương]

Function:

Function fRNG(rng As Range) As Variant
Dim Dic As Object: Set Dic = CreateObject("Scripting.Dictionary")
Dim tmp As Variant, r As Long, z As Long, c As Long, KQ() As Variant, arr As Variant, T
tmp = rng.Value: z = UBound(tmp, 2)
For r = 1 To UBound(tmp, 1)
    For c = 1 To z
        If tmp(r, c) <> "" And Not Dic.Exists(tmp(r, c)) Then Dic.Add tmp(r, c), ""
    Next c
Next r
Erase tmp: tmp = Dic.Keys
z = UBound(tmp)
ReDim KQ(1 To z + 1, 0)
For r = 0 To z
    T = tmp(r)
    If IsNumeric(T) Then
        KQ(r + 1, 0) = T
    Else
        arr = Split(Replace(T, " ", ""), "&")
        KQ(r + 1, 0) = Join(sMinMax(arr), " & ")
    End If
Next r
fRNG = KQ
End Function
'--------------------------------------------------------
Public Function sMinMax(arr As Variant) As Variant
Dim tmp As Variant, i As Long, j As Long, z As Long
If Not IsArray(arr) Then Exit Function
z = UBound(arr)
For i = LBound(arr) To UBound(arr)
    For j = i + 1 To UBound(arr)
      If CLng(arr(i)) > CLng(arr(j)) Then
        tmp = arr(j)
        arr(j) = arr(i)
        arr(i) = tmp
      End If
    Next j
Next i
sMinMax = arr
End Function

Sub:

Sub Main()
Dim rng As Range, z As Long, tmp As Variant
z = ActiveCell.SpecialCells(xlLastCell).Row
Set rng = Range("C5:I" & z)
tmp = fRNG(rng)
Range("K5").Resize(UBound(tmp, 1), 1) = tmp
End Sub

befaint

Lợi hại quá befaint ơi, trên cả sự mong đợi của Oanh Thơ rồi hỏi 1 ý bạn làm cho cả 2 ý 2 hihi (y)
Còn một tý xíu nữa bạn chỉnh lại giúp mình với.1

Code của bạn hình như là Lọc duy nhất trước sau mới Sort vì vậy mà dữ liệu trong vùng Lọc duy nhất tại cột K vẫn có số liệu trùng nhau.
Bạn có thể sửa lại giúp Oanh Thơ là sort toàn bộ vùng dữ liệu "C5:I" trước sau đó mới lọc sang cột K được không ạ.

Oanh Thơ gửi file đính kèm để bạn kiểm tra lại nhé.
Trân trọng cảm ơn.

 

[befaint]

Function fRNG(rng As Range) As Variant
Dim Dic As Object: Set Dic = CreateObject("Scripting.Dictionary")
Dim tmp As Variant, r As Long, z As Long, c As Long, KQ() As Variant, arr As Variant, T
tmp = rng.Value: z = UBound(tmp, 2)
For r = 1 To UBound(tmp, 1)
    For c = 1 To z
        T = tmp(r, c)
        If T <> Empty Then
            T = Replace(T, " ", "")
            If IsNumeric(T) = False Then
                arr = Split(T, "&")
                T = Join(sMinMax(arr), " & ")
                Erase arr
            End If
            If Not Dic.Exists(T) Then Dic.Add T, ""
        End If
    Next c
Next r
Erase tmp: tmp = Dic.Keys: z = UBound(tmp)
ReDim KQ(1 To z + 1, 0)
For r = 0 To z
    KQ(r + 1, 0) = tmp(r)
Next r
fRNG = KQ
End Function

Phần còn lại giữ nguyên.

 

[ndu96081631]

Xin chào be09 cùng các bạn,

Oanh Thơ cũng đang gặp phải 1 vấn đề về dạng bài toán sắp xếp chuỗi số trong 1 ô,cụ thể:
Ví vùng A1:A123 Oanh Thơ nhập 1 chuỗi số có dạng như sau:

12&123&34&13&66

làm thế nào để kết quả các chuỗi số nhập trong vùng A1:A123 trả về được sắp xếp theo thứ tự từ nhở đến lớn như bên dưới.

=> 12&13&34&66&123

Cụ thể dãy số này Oanh Thơ đã có 1 bài toán và file đính kèm ở đây ạ:

https://www.giaiphapexcel.com/forum/showthread.php?121612-Lọc-duy-nhất&p=761165#post761165

Kính mong nhận được sự giúp đỡ của các bạn.
Trân trọng cảm ơn.
Oanh Thơ

Sort số trong chuỗi: Vấn đề này tôi nghiên cứu cũng lâu rồi. Tặng bạn hàm:

Function StrSort(ByVal Text As String, ByVal Delimiter As String, Optional ByVal Order As Boolean = False) As String
  Dim aTmp, item
  Dim strDes As String, strTmp As String
  Dim n As Long
  On Error Resume Next
  aTmp = Split(Text, Delimiter)
  ReDim arr(1 To 1)
  For Each item In aTmp
    strTmp = Trim(item)
    If Len(strTmp) Then
      If IsNumeric(strTmp) Then
        n = CLng(strTmp)
        If n > UBound(arr) Then ReDim Preserve arr(1 To n)
        arr(n) = arr(n) & " " & IIf(Order, StrReverse(n), n)
      End If
    End If
  Next
  strDes = WorksheetFunction.Trim(Join(arr, " "))
  If Order Then strDes = StrReverse(strDes)
  StrSort = Replace(strDes, " ", Delimiter)
End Function

Cho phép sort tăng hoặc giảm dần với dấu phân cách tùy chọn

 

[Hoàng Nhật Phương]

Function fRNG(rng As Range) As Variant
Dim Dic As Object: Set Dic = CreateObject("Scripting.Dictionary")
Dim tmp As Variant, r As Long, z As Long, c As Long, KQ() As Variant, arr As Variant, T
tmp = rng.Value: z = UBound(tmp, 2)
For r = 1 To UBound(tmp, 1)
    For c = 1 To z
        T = tmp(r, c)
        If T <> Empty Then
            T = Replace(T, " ", "")
            If IsNumeric(T) = False Then
                arr = Split(T, "&")
                T = Join(sMinMax(arr), " & ")
                Erase arr
            End If
            If Not Dic.Exists(T) Then Dic.Add T, ""
        End If
    Next c
Next r
Erase tmp: tmp = Dic.Keys: z = UBound(tmp)
ReDim KQ(1 To z + 1, 0)
For r = 0 To z
    KQ(r + 1, 0) = tmp(r)
Next r
fRNG = KQ
End Function

Phần còn lại giữ nguyên.

Ưng quá rồi! Xin cảm ơn befaint hén.

Sort số trong chuỗi: Vấn đề này tôi nghiên cứu cũng lâu rồi. Tặng bạn hàm:

Function StrSort(ByVal Text As String, ByVal Delimiter As String, Optional ByVal Order As Boolean = False) As String
  Dim aTmp, item
  Dim strDes As String, strTmp As String
  Dim n As Long
  On Error Resume Next
  aTmp = Split(Text, Delimiter)
  ReDim arr(1 To 1)
  For Each item In aTmp
    strTmp = Trim(item)
    If Len(strTmp) Then
      If IsNumeric(strTmp) Then
        n = CLng(strTmp)
        If n > UBound(arr) Then ReDim Preserve arr(1 To n)
        arr(n) = arr(n) & " " & IIf(Order, StrReverse(n), n)
      End If
    End If
  Next
  strDes = WorksheetFunction.Trim(Join(arr, " "))
  If Order Then strDes = StrReverse(strDes)
  StrSort = Replace(strDes, " ", Delimiter)
End Function

Cho phép sort tăng hoặc giảm dần với dấu phân cách tùy chọn

Cảm ơn ndu96081631 bạn có thể chỉ cho Oanh Thơ biết vận dụng hàm trên bằng việc chạy code cho vùng dữ liệu A1:A123 được không ạ.
Bài toàn này nếu Oanh Thơ sử dụng công thức nhập vào cell giống như bạn be09 nêu ở bài1 thì sẽ hơi bất cập ạ.

Một lần nữa cảm ơn ndu96081631 ,cảm ơn befaint nhiều nhé.
Oanh Thơ.

 

[Hoàng Nhật Phương]

Xin chào tất cả các bạn.
Với tập tin đính kèm tại bài 3, code đang bao gồm 2 công đoạn: Sắp xếp và lọc duy nhất.
Giờ tôi muốn bỏ bước lọc duy nhất đi mà chỉ thực hiện thao tác sắp xếp thì code phải sửa như thế nào ạ.

Mong muốn thực hiện như bài 2 đã nêu ạ:

Xin chào be09 cùng các bạn,

Oanh Thơ cũng đang gặp phải 1 vấn đề về dạng bài toán sắp xếp chuỗi số trong 1 ô,cụ thể:
Ví vùng A1:A123 Oanh Thơ nhập 1 chuỗi số có dạng như sau:

12&123&34&13&66

làm thế nào để kết quả các chuỗi số nhập trong vùng A1:A123 trả về được sắp xếp theo thứ tự từ nhở đến lớn như bên dưới.

=> 12&13&34&66&123

Cụ thể dãy số này Oanh Thơ đã có 1 bài toán và file đính kèm ở đây ạ:

https://www.giaiphapexcel.com/forum/showthread.php?121612-Lọc-duy-nhất&p=761165#post761165

Kính mong nhận được sự giúp đỡ của các bạn.
Trân trọng cảm ơn.
Oanh Thơ

 

[HieuCD]

Xin chào tất cả các bạn.
Với tập tin đính kèm tại bài 3, code đang bao gồm 2 công đoạn: Sắp xếp và lọc duy nhất.
Giờ tôi muốn bỏ bước lọc duy nhất đi mà chỉ thực hiện thao tác sắp xếp thì code phải sửa như thế nào ạ.
Mong muốn thực hiện như bài 2 đã nêu ạ:

chưa biết rỏ bạn muốn trình bày kết quả thế nào?
chạy thử code

Sub Main()
  Dim Darr As Variant, Arr As Variant, LastR As Long, Tmp As Variant
  Dim i As Long, k As Long, j As Byte
  LastR = ActiveCell.SpecialCells(xlLastCell).Row
  Darr = Range("C5:I" & LastR).Value
  ReDim Arr(1 To UBound(Darr, 1) * UBound(Darr, 2), 1 To 1)
  For j = 1 To UBound(Darr, 2)
    For i = 1 To UBound(Darr, 1)
      Tmp = Darr(i, j)
      If Tmp <> "" Then
        k = k + 1
        If IsNumeric(T) Then
          Arr(k, 1) = Tmp
        Else
          Arr(k, 1) = SortChar(Tmp)
        End If
      End If
    Next i
  Next j
  Range("K5").Resize(k, 1) = Arr
End Sub
Function SortChar(Str As Variant) As String
  Dim S As Variant, i As Byte, n As Byte, Tmp As Long
  S = Split(Replace(Str, " ", ""), "&")
  If Not IsArray(Arr) Then Exit Function
  For i = 0 To UBound(S)
    For n = i + 1 To UBound(S)
      If CLng(S(i)) > CLng(S(n)) Then
        Tmp = S(n):     S(n) = S(i):     S(i) = Tmp
      End If
    Next n
Next i
SortChar = Join(S, " & ")
End Function

 

[Hoàng Nhật Phương]

chưa biết rỏ bạn muốn trình bày kết quả thế nào?
chạy thử code

Sub Main()
  Dim Darr As Variant, Arr As Variant, LastR As Long, Tmp As Variant
  Dim i As Long, k As Long, j As Byte
  LastR = ActiveCell.SpecialCells(xlLastCell).Row
  Darr = Range("C5:I" & LastR).Value
  ReDim Arr(1 To UBound(Darr, 1) * UBound(Darr, 2), 1 To 1)
  For j = 1 To UBound(Darr, 2)
    For i = 1 To UBound(Darr, 1)
      Tmp = Darr(i, j)
      If Tmp <> "" Then
        k = k + 1
        If IsNumeric(T) Then
          Arr(k, 1) = Tmp
        Else
          Arr(k, 1) = SortChar(Tmp)
        End If
      End If
    Next i
  Next j
  Range("K5").Resize(k, 1) = Arr
End Sub
Function SortChar(Str As Variant) As String
  Dim S As Variant, i As Byte, n As Byte, Tmp As Long
  S = Split(Replace(Str, " ", ""), "&")
  If Not IsArray(Arr) Then Exit Function
  For i = 0 To UBound(S)
    For n = i + 1 To UBound(S)
      If CLng(S(i)) > CLng(S(n)) Then
        Tmp = S(n):     S(n) = S(i):     S(i) = Tmp
      End If
    Next n
Next i
SortChar = Join(S, " & ")
End Function

Xin chào HieuCD,
Cảm ơn bạn đã hỗ trợ, tôi đã chạy thử code trên hình như code và thấy kết quả chưa sắp xếp được các số trong cell theo mong muốn.
Nhờ bạn và các bạn hỗ trợ thêm ạ.

Chúc cả nhà ngày mới nhiều niềm vui

 

[HieuCD]

Xin chào HieuCD,
Cảm ơn bạn đã hỗ trợ, tôi đã chạy thử code trên hình như code và thấy kết quả chưa sắp xếp được các số trong cell theo mong muốn.
Nhờ bạn và các bạn hỗ trợ thêm ạ.
Chúc cả nhà ngày mới nhiều niềm vui

tối qua chỉnh thiếu vài chổ, bạn chạy lại code

Sub Main()
  Dim Darr As Variant, Arr As Variant, i As Long, Tmp As Variant
  i = ActiveCell.SpecialCells(xlLastCell).Row
  Darr = Range("C5:c" & i).Value
  ReDim Arr(1 To UBound(Darr, 1), 1 To 1)
    For i = 1 To UBound(Darr, 1)
      Tmp = Darr(i, 1)
      If Tmp <> "" Then
        If IsNumeric(Tmp) Then
          Arr(i, 1) = Tmp
        Else
          Arr(i, 1) = SortChar(Tmp)
        End If
      End If
    Next i
  Range("K5").Resize(UBound(Darr, 1), 1) = Arr
End Sub


Function SortChar(Str As Variant) As String
  Dim S As Variant, i As Byte, n As Byte, Tmp As Long
  S = Split(Replace(Str, " ", ""), "&")
  If Not IsArray(S) Then Exit Function
  For i = 0 To UBound(S)
    For n = i + 1 To UBound(S)
      If CLng(S(i)) > CLng(S(n)) Then
        Tmp = S(n):     S(n) = S(i):     S(i) = Tmp
      End If
    Next n
Next i
SortChar = Join(S, " & ")
End Function

 

[Hoàng Nhật Phương]

tối qua chỉnh thiếu vài chổ, bạn chạy lại code

Sub Main()
  Dim Darr As Variant, Arr As Variant, i As Long, Tmp As Variant
  i = ActiveCell.SpecialCells(xlLastCell).Row
  Darr = Range("C5:c" & i).Value
  ReDim Arr(1 To UBound(Darr, 1), 1 To 1)
    For i = 1 To UBound(Darr, 1)
      Tmp = Darr(i, 1)
      If Tmp <> "" Then
        If IsNumeric(Tmp) Then
          Arr(i, 1) = Tmp
        Else
          Arr(i, 1) = SortChar(Tmp)
        End If
      End If
    Next i
  Range("K5").Resize(UBound(Darr, 1), 1) = Arr
End Sub


Function SortChar(Str As Variant) As String
  Dim S As Variant, i As Byte, n As Byte, Tmp As Long
  S = Split(Replace(Str, " ", ""), "&")
  If Not IsArray(S) Then Exit Function
  For i = 0 To UBound(S)
    For n = i + 1 To UBound(S)
      If CLng(S(i)) > CLng(S(n)) Then
        Tmp = S(n):     S(n) = S(i):     S(i) = Tmp
      End If
    Next n
Next i
SortChar = Join(S, " & ")
End Function

Cảm ơn HieuCD, nhiều nhé!
Nhờ bạn mà tôi đã giải quyết được bài báo cáo của mình.