Sắp xếp các số trong chuỗi số (1 người xem)

Thiên Thanh1 · 24/9/21

Em có ví dụ như trong file đính kèm
Nhờ anh chị em và các thày cô giúp đỡ

snow25 · 24/9/21

Thiên Thanh1 đã viết:
Em có ví dụ như trong file đính kèm
Nhờ anh chị em và các thày cô giúp đỡ

Bạn thử cái hàm này.

Mã:

Function xapxep(dayso As String) As String
    Dim i As Long, T, kq(1 To 100, 1 To 2) As String, j As Integer, s As String, b As Integer, ketqua As String
    Dim a As Integer, dic As Object
    Set dic = CreateObject("scripting.dictionary")
    For Each T In Split(dayso, ",")
        If Not dic.exists(T) Then
           a = a + 1
           dic.Add T, a
           kq(a, 1) = T
           kq(a, 2) = 1
        Else
           kq(dic.Item(T), 2) = kq(dic.Item(T), 2) + 1
        End If
    Next
    For i = 1 To a
        For j = i To a - 1
           If kq(i, 2) < kq(j + 1, 2) Then
              s = kq(i, 1)
              b = kq(i, 2)
              kq(i, 1) = kq(j + 1, 1)
              kq(i, 2) = kq(j + 1, 2)
              kq(j + 1, 1) = s
              kq(j + 1, 2) = b
           ElseIf kq(i, 2) = kq(j + 1, 2) Then
              If CLng(kq(i, 1)) < CLng(kq(j + 1, 1)) Then
                s = kq(i, 1)
                b = kq(i, 2)
                kq(i, 1) = kq(j + 1, 1)
                kq(i, 2) = kq(j + 1, 2)
                kq(j + 1, 1) = s
                kq(j + 1, 2) = b
              End If
           End If
       Next j
    Next i
    For i = 1 To a
        ketqua = ketqua & "," & kq(i, 1)
    Next i
    For i = 99 To 0 Step -1
        If i > 10 Then s = i Else s = "0" & i
        If Not dic.exists(s) Then
           ketqua = ketqua & "," & s
        End If
   Next i
   Set dic = Nothing
        xapxep = Right(ketqua, Len(ketqua) - 1)
        
End Function

=xapxep(G5)

hocexcel_1991 · 24/9/21

Thiên Thanh1 đã viết:
Em có ví dụ như trong file đính kèm
Nhờ anh chị em và các thày cô giúp đỡ

Nếu bạn dùng ofice365 thì thử công thức này xem có đúng không.

Mã:

=LET(a,FILTERXML("<a><b>"&SUBSTITUTE(G5,",","</b><b>")&"</b></a>","//b"),b,SORT(UNIQUE(a),,-1),c,MMULT(N(b=TRANSPOSE(a)),SEQUENCE(COUNTA(a))^0),d,SORTBY(CHOOSE({1,2},TEXT(b,"00"),c),c,-1),TEXTJOIN(",",1,INDEX(d,,1),IF(ISNA(MATCH(100-ROW($1:$100),b,)),TEXT(100-ROW($1:$100),"00"),"")))

Thiên Thanh1 · 24/9/21

snow25 đã viết:

Bạn thử cái hàm này.

Mã:

Function xapxep(dayso As String) As String
    Dim i As Long, T, kq(1 To 100, 1 To 2) As String, j As Integer, s As String, b As Integer, ketqua As String
    Dim a As Integer, dic As Object
    Set dic = CreateObject("scripting.dictionary")
    For Each T In Split(dayso, ",")
        If Not dic.exists(T) Then
           a = a + 1
           dic.Add T, a
           kq(a, 1) = T
           kq(a, 2) = 1
        Else
           kq(dic.Item(T), 2) = kq(dic.Item(T), 2) + 1
        End If
    Next
    For i = 1 To a
        For j = i To a - 1
           If kq(i, 2) < kq(j + 1, 2) Then
              s = kq(i, 1)
              b = kq(i, 2)
              kq(i, 1) = kq(j + 1, 1)
              kq(i, 2) = kq(j + 1, 2)
              kq(j + 1, 1) = s
              kq(j + 1, 2) = b
           ElseIf kq(i, 2) = kq(j + 1, 2) Then
              If CLng(kq(i, 1)) < CLng(kq(j + 1, 1)) Then
                s = kq(i, 1)
                b = kq(i, 2)
                kq(i, 1) = kq(j + 1, 1)
                kq(i, 2) = kq(j + 1, 2)
                kq(j + 1, 1) = s
                kq(j + 1, 2) = b
              End If
           End If
       Next j
    Next i
    For i = 1 To a
        ketqua = ketqua & "," & kq(i, 1)
    Next i
    For i = 99 To 0 Step -1
        If i > 10 Then s = i Else s = "0" & i
        If Not dic.exists(s) Then
           ketqua = ketqua & "," & s
        End If
   Next i
   Set dic = Nothing
        xapxep = Right(ketqua, Len(ketqua) - 1)
       
End Function

=xapxep(G5)

Cảm ơn bạn @snow25 hàm rất đúng, rất chuẩn siêu quá bạn ơi.
Cảm ơn công thức của bạn @hocexcel_1991 công thức của bạn cũng rất đúng
Chúc các bạn cùng anh chị em cô chú bác trên diễn đàn GPE vui vẻ.

Thiên Thanh1 · 24/9/21

@snow25 làm ơn chỉnh cho công thức chọn được nhiều vùng giúp mình với nhé
Cảm ơn bạn

snow25 · 24/9/21

Thiên Thanh1 đã viết:
@snow25 làm ơn chỉnh cho công thức chọn được nhiều vùng giúp mình với nhé
Cảm ơn bạn

Bạn thử xem đúng không.

Mã:

Function xapxep(ParamArray mang()) As String
    Dim i As Long, T, kq(1 To 100, 1 To 2) As String, j As Integer, s As String, b As Integer, ketqua As String
    Dim a As Integer, dic As Object, dayso
    Set dic = CreateObject("scripting.dictionary")
    For Each dayso In mang
    For Each T In Split(dayso, ",")
        If Not dic.exists(T) Then
           a = a + 1
           dic.Add T, a
           kq(a, 1) = T
           kq(a, 2) = 1
        Else
           kq(dic.Item(T), 2) = kq(dic.Item(T), 2) + 1
        End If
    Next
    Next
    For i = 1 To a
        For j = i To a - 1
           If kq(i, 2) < kq(j + 1, 2) Then
              s = kq(i, 1)
              b = kq(i, 2)
              kq(i, 1) = kq(j + 1, 1)
              kq(i, 2) = kq(j + 1, 2)
              kq(j + 1, 1) = s
              kq(j + 1, 2) = b
           ElseIf kq(i, 2) = kq(j + 1, 2) Then
              If CLng(kq(i, 1)) < CLng(kq(j + 1, 1)) Then
                s = kq(i, 1)
                b = kq(i, 2)
                kq(i, 1) = kq(j + 1, 1)
                kq(i, 2) = kq(j + 1, 2)
                kq(j + 1, 1) = s
                kq(j + 1, 2) = b
              End If
           End If
       Next j
    Next i
    For i = 1 To a
        ketqua = ketqua & "," & kq(i, 1)
    Next i
    For i = 99 To 0 Step -1
        If i > 10 Then s = i Else s = "0" & i
        If Not dic.exists(s) Then
           ketqua = ketqua & "," & s
        End If
   Next i
   Set dic = Nothing
        xapxep = Right(ketqua, Len(ketqua) - 1)
        
End Function

Thiên Thanh1 · 24/9/21

snow25 đã viết:

Bạn thử xem đúng không.

Mã:

Function xapxep(ParamArray mang()) As String
    Dim i As Long, T, kq(1 To 100, 1 To 2) As String, j As Integer, s As String, b As Integer, ketqua As String
    Dim a As Integer, dic As Object, dayso
    Set dic = CreateObject("scripting.dictionary")
    For Each dayso In mang
    For Each T In Split(dayso, ",")
        If Not dic.exists(T) Then
           a = a + 1
           dic.Add T, a
           kq(a, 1) = T
           kq(a, 2) = 1
        Else
           kq(dic.Item(T), 2) = kq(dic.Item(T), 2) + 1
        End If
    Next
    Next
    For i = 1 To a
        For j = i To a - 1
           If kq(i, 2) < kq(j + 1, 2) Then
              s = kq(i, 1)
              b = kq(i, 2)
              kq(i, 1) = kq(j + 1, 1)
              kq(i, 2) = kq(j + 1, 2)
              kq(j + 1, 1) = s
              kq(j + 1, 2) = b
           ElseIf kq(i, 2) = kq(j + 1, 2) Then
              If CLng(kq(i, 1)) < CLng(kq(j + 1, 1)) Then
                s = kq(i, 1)
                b = kq(i, 2)
                kq(i, 1) = kq(j + 1, 1)
                kq(i, 2) = kq(j + 1, 2)
                kq(j + 1, 1) = s
                kq(j + 1, 2) = b
              End If
           End If
       Next j
    Next i
    For i = 1 To a
        ketqua = ketqua & "," & kq(i, 1)
    Next i
    For i = 99 To 0 Step -1
        If i > 10 Then s = i Else s = "0" & i
        If Not dic.exists(s) Then
           ketqua = ketqua & "," & s
        End If
   Next i
   Set dic = Nothing
        xapxep = Right(ketqua, Len(ketqua) - 1)
     
End Function

Bạn @snow25 làm nhanh quá, cảm ơn bạn rất nhiều nhé
Bạn ơi hàm đã chọn được nhiều ô, nhưng là chọn được các ô riêng rẽ( Không chọn được cả 1 vùng)
=xapxep(G5;G17;h3)
Mình muốn hàm chọn được vùng các ô liên tiếp và cả ô riêng rẽ nữa
Ví dụ: =xapxep(A1:C5;B3:h7;d6;k5)
Bạn chỉnh giúp mình với nhé
Cảm ơn bạn @snow25 nhé

Sắp xếp các số trong chuỗi số (1 người xem)

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

Thiên Thanh1

Thành viên mới

File đính kèm

snow25

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

hocexcel_1991

Bắt đầu học Excel

Thiên Thanh1

Thành viên mới

Thiên Thanh1

Thành viên mới

snow25

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

Thiên Thanh1

Thành viên mới

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

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

Sinh nhật lần 19 GPE