Cần giúp hàm tự tạo sắp xếp mảng có phần tử rỗng ("")

hktanh · 12/9/19

Chào các bạn của giải pháp Excel. Mình có một bảng dữ liệu mẫu nhỏ như ở phía dưới, trong đó có hàm tự tạo lọc duy nhất mà mình tìm được trên mạng. Sau khi lọc được những giá trị duy nhất bằng hàm mảng đó rồi thì mình gặp phải một khó khăn đó là mình không thể sắp xếp lại được những giá trị của hàm mảng, cho nên mình rất cần bạn nào đó có thể giúp mình viết một hàm mảng sắp xếp theo hai cách tăng hoặc giảm dần như trong file mình có nêu để đi kèm với hàm mảng lọc duy nhất kia nhằm tạo ra được một mảng giá trị duy nhất đã được sắp xếp chỉ bằng hai hàm tự tạo là hàm sắp xếp và lọc duy nhất. Các bạn lưu ý là trong những giá trị mình cần sắp xếp có cả dạng công thức ="" (rỗng nhưng vẫn có công thức), các bạn giúp mình là nếu ô giá trị cần sắp xếp có ="" thì cái ="" này sẽ bị đẩy xuống dưới bất kể mình sắp xếp theo cách tăng hay giảm dần. Với các bạn nếu có thể viết cho mình được một hàm sắp xếp (trong danh sách chưa sắp xếp có cả ="") sao cho sau khi sắp xếp thì các cái ="" bị đẩy xuống dưới bất kể sắp xếp tăng dần hay giảm dần và hàm sắp xếp này có thể kéo copy công thức xuống được như một hàm bình thường thì càng tốt. Cảm ơn các bạn

snow25 · 12/9/19

hktanh đã viết:
Chào các bạn của giải pháp Excel. Mình có một bảng dữ liệu mẫu nhỏ như ở phía dưới, trong đó có hàm tự tạo lọc duy nhất mà mình tìm được trên mạng. Sau khi lọc được những giá trị duy nhất bằng hàm mảng đó rồi thì mình gặp phải một khó khăn đó là mình không thể sắp xếp lại được những giá trị của hàm mảng, cho nên mình rất cần bạn nào đó có thể giúp mình viết một hàm mảng sắp xếp theo hai cách tăng hoặc giảm dần như trong file mình có nêu để đi kèm với hàm mảng lọc duy nhất kia nhằm tạo ra được một mảng giá trị duy nhất đã được sắp xếp chỉ bằng hai hàm tự tạo là hàm sắp xếp và lọc duy nhất. Các bạn lưu ý là trong những giá trị mình cần sắp xếp có cả dạng công thức ="" (rỗng nhưng vẫn có công thức), các bạn giúp mình là nếu ô giá trị cần sắp xếp có ="" thì cái ="" này sẽ bị đẩy xuống dưới bất kể mình sắp xếp theo cách tăng hay giảm dần. Với các bạn nếu có thể viết cho mình được một hàm sắp xếp (trong danh sách chưa sắp xếp có cả ="") sao cho sau khi sắp xếp thì các cái ="" bị đẩy xuống dưới bất kể sắp xếp tăng dần hay giảm dần và hàm sắp xếp này có thể kéo copy công thức xuống được như một hàm bình thường thì càng tốt. Cảm ơn các bạn

Bạn thử.

Mã:

Function sapxep(ByVal mang As Range, ByVal so As Boolean)
       Dim T, dk As String, olit As Object, kq() As String, i As Long, a As Long
       Set olit = CreateObject("System.Collections.SortedList")
       For Each T In mang
          dk = T.Value
         If Not olit.Contains(dk) Then
            olit.Add dk, ""
         End If
       Next
       ReDim kq(1 To mang.Count, 1 To 1)
       If so = True Then
          For i = 0 To olit.Count - 1
              a = a + 1
              kq(a, 1) = olit.Getkey(i)
          Next i
       Else
          For i = olit.Count - 1 To 0 Step -1
             a = a + 1
             kq(a, 1) = olit.Getkey(i)
          Next i
       End If
       sapxep = kq
End Function

Mã:

=sapxep(E7:E24,0)

hktanh · 12/9/19

snow25 đã viết:

Bạn thử.

Mã:

Function sapxep(ByVal mang As Range, ByVal so As Boolean)
       Dim T, dk As String, olit As Object, kq() As String, i As Long, a As Long
       Set olit = CreateObject("System.Collections.SortedList")
       For Each T In mang
          dk = T.Value
         If Not olit.Contains(dk) Then
            olit.Add dk, ""
         End If
       Next
       ReDim kq(1 To mang.Count, 1 To 1)
       If so = True Then
          For i = 0 To olit.Count - 1
              a = a + 1
              kq(a, 1) = olit.Getkey(i)
          Next i
       Else
          For i = olit.Count - 1 To 0 Step -1
             a = a + 1
             kq(a, 1) = olit.Getkey(i)
          Next i
       End If
       sapxep = kq
End Function

Mã:

=sapxep(E7:E24,0)

Cảm ơn bạn nhiều nhé, hàm của bạn rất hay, mình sẽ lưu lại, hihi ^^

Bài đã được tự động gộp: 12/9/19

snow25 đã viết:

Bạn thử.

Mã:

Function sapxep(ByVal mang As Range, ByVal so As Boolean)
       Dim T, dk As String, olit As Object, kq() As String, i As Long, a As Long
       Set olit = CreateObject("System.Collections.SortedList")
       For Each T In mang
          dk = T.Value
         If Not olit.Contains(dk) Then
            olit.Add dk, ""
         End If
       Next
       ReDim kq(1 To mang.Count, 1 To 1)
       If so = True Then
          For i = 0 To olit.Count - 1
              a = a + 1
              kq(a, 1) = olit.Getkey(i)
          Next i
       Else
          For i = olit.Count - 1 To 0 Step -1
             a = a + 1
             kq(a, 1) = olit.Getkey(i)
          Next i
       End If
       sapxep = kq
End Function

Mã:

=sapxep(E7:E24,0)

update

) À mà nếu sắp xếp danh sách trùng nhau thì mình cũng không thể làm cho các dòng sau khi sắp xếp vẫn tương ứng nhau bạn nhỉ, mình mới nhận ra điều này

)) không biết mình nghĩ thế có đúng không :"))) . Mình nghĩ nếu hàm sắp xếp danh sách trùng nhau như vậy nếu dùng trong tính toán chắc nó phải trả về cả mảng lớn để cho các dòng tương ứng cũng được sắp xếp thì mới đúng bạn nhỉ
Trả lời cũ: bạn ơi nếu bạn viết cho mình thêm được phần sắp xếp danh sách có giá trị trùng nhau, chẳng hạn 1 2 3 1 2 thành 1 1 2 2 3 nếu tham số = 1 ; 3 2 2 1 1 nếu tham số bằng 0, tức là chỉ sắp xếp chứ chưa lọc giá trị duy nhất thì vấn đề của mình coi như giải quyết xong ^^ dù sao vẫn cảm ơn rất nhiều về hàm mà bạn vừa viết

. Tại mình thấy dùng cái Data - Sort với cái AutoFilter thì cũng chỉ sắp xếp một cách tạm thời thôi ý, lúc nhập giá trị mới thì lại phải Sort lại, với cái AutoFliter mà sắp xếp thì phải có tiêu đề và không có dòng trống nữa cơ, nhiều thủ tục quá

hktanh · 12/9/19

snow25 đã viết:

Bạn thử.

Mã:

Function sapxep(ByVal mang As Range, ByVal so As Boolean)
       Dim T, dk As String, olit As Object, kq() As String, i As Long, a As Long
       Set olit = CreateObject("System.Collections.SortedList")
       For Each T In mang
          dk = T.Value
         If Not olit.Contains(dk) Then
            olit.Add dk, ""
         End If
       Next
       ReDim kq(1 To mang.Count, 1 To 1)
       If so = True Then
          For i = 0 To olit.Count - 1
              a = a + 1
              kq(a, 1) = olit.Getkey(i)
          Next i
       Else
          For i = olit.Count - 1 To 0 Step -1
             a = a + 1
             kq(a, 1) = olit.Getkey(i)
          Next i
       End If
       sapxep = kq
End Function

Mã:

=sapxep(E7:E24,0)

Bạn ơi, sau khi sử dụng hàm của bạn mình phát hiện ra vấn đề này, đó là khi trong danh sách sắp xếp có những ký tự đặc biệt như %% ; $$ ; #1 ; ** ; ( ) chẳng hạn thì những ký tự đặc biệt này không được đưa lên trên khi mình sắp xếp theo thứ tự giảm dần bạn ạ , bạn giúp mình với nhé :victory:

snow25 · 12/9/19

hktanh đã viết:
Bạn ơi, sau khi sử dụng hàm của bạn mình phát hiện ra vấn đề này, đó là khi trong danh sách sắp xếp có những ký tự đặc biệt như %% ; $$ ; #1 ; ** ; ( ) chẳng hạn thì những ký tự đặc biệt này không được đưa lên trên khi mình sắp xếp theo thứ tự giảm dần bạn ạ , bạn giúp mình với nhé

Bạn đưa dữ liệu lên xem nào.Mà nó sắp xếp theo kiểu giống sort trong excel mà.

hktanh · 12/9/19

snow25 đã viết:
Bạn đưa dữ liệu lên xem nào.Mà nó sắp xếp theo kiểu giống sort trong excel mà.

bạn ơi file ví dụ đây bạn nhé :1a:

mình sắp xếp theo hướng giảm dần và trong danh sách có ký tự đặc biệt. Bạn xem giúp mình nhé

hktanh · 13/9/19

snow25 đã viết:
Bạn đưa dữ liệu lên xem nào.Mà nó sắp xếp theo kiểu giống sort trong excel mà.

Bạn ơi giúp mình với nhé, mình để file thử nghiệm hàm sắp xếp của bạn ở trên rồi đó :sweatdrop:

snow25 · 13/9/19

hktanh đã viết:
Bạn ơi giúp mình với nhé, mình để file thử nghiệm hàm sắp xếp của bạn ở trên rồi đó

Bạn thử.

Mã:

Function sapxep(ByVal mang As Range, ByVal so As Boolean)
       Dim T, dk As String, dks As Double, olit As Object, kq() As String, i As Long, a As Long, olit1 As Object
       Set olit1 = CreateObject("System.Collections.SortedList")
       Set olit = CreateObject("System.Collections.SortedList")
       For Each T In mang
         If IsNumeric(T.Value) And Len(T.Value) > 0 Then
            dks = T.Value
            If Not olit1.Contains(dks) Then
               olit1.Add dks, ""
            End If
         Else
            dk = T.Value
            If Not olit.Contains(dk) Then
               olit.Add dk, ""
            End If
         End If
       Next
       ReDim kq(1 To mang.Count, 1 To 1)
       If so = True Then
          For i = 0 To olit1.Count - 1
              a = a + 1
              kq(a, 1) = olit1.Getkey(i)
          Next i
          For i = 0 To olit.Count - 1
              a = a + 1
              kq(a, 1) = olit.Getkey(i)
          Next i
       Else
          For i = olit.Count - 1 To 0 Step -1
             a = a + 1
             kq(a, 1) = olit.Getkey(i)
          Next i
          For i = olit1.Count - 1 To 0 Step -1
             a = a + 1
             kq(a, 1) = olit1.Getkey(i)
          Next i
       End If
       Set olit = Nothing
       Set olit1 = Nothing
       sapxep = kq
End Function

hktanh · 13/9/19

snow25 đã viết:

Bạn thử.

Mã:

Function sapxep(ByVal mang As Range, ByVal so As Boolean)
       Dim T, dk As String, dks As Double, olit As Object, kq() As String, i As Long, a As Long, olit1 As Object
       Set olit1 = CreateObject("System.Collections.SortedList")
       Set olit = CreateObject("System.Collections.SortedList")
       For Each T In mang
         If IsNumeric(T.Value) And Len(T.Value) > 0 Then
            dks = T.Value
            If Not olit1.Contains(dks) Then
               olit1.Add dks, ""
            End If
         Else
            dk = T.Value
            If Not olit.Contains(dk) Then
               olit.Add dk, ""
            End If
         End If
       Next
       ReDim kq(1 To mang.Count, 1 To 1)
       If so = True Then
          For i = 0 To olit1.Count - 1
              a = a + 1
              kq(a, 1) = olit1.Getkey(i)
          Next i
          For i = 0 To olit.Count - 1
              a = a + 1
              kq(a, 1) = olit.Getkey(i)
          Next i
       Else
          For i = olit.Count - 1 To 0 Step -1
             a = a + 1
             kq(a, 1) = olit.Getkey(i)
          Next i
          For i = olit1.Count - 1 To 0 Step -1
             a = a + 1
             kq(a, 1) = olit1.Getkey(i)
          Next i
       End If
       Set olit = Nothing
       Set olit1 = Nothing
       sapxep = kq
End Function

hí hí, cảm ơn bạn nhiều lắm, hàm của bạn hoạt động rất tốt

hktanh · 24/9/19

snow25 đã viết:

Bạn thử.

Mã:

Function sapxep(ByVal mang As Range, ByVal so As Boolean)
       Dim T, dk As String, dks As Double, olit As Object, kq() As String, i As Long, a As Long, olit1 As Object
       Set olit1 = CreateObject("System.Collections.SortedList")
       Set olit = CreateObject("System.Collections.SortedList")
       For Each T In mang
         If IsNumeric(T.Value) And Len(T.Value) > 0 Then
            dks = T.Value
            If Not olit1.Contains(dks) Then
               olit1.Add dks, ""
            End If
         Else
            dk = T.Value
            If Not olit.Contains(dk) Then
               olit.Add dk, ""
            End If
         End If
       Next
       ReDim kq(1 To mang.Count, 1 To 1)
       If so = True Then
          For i = 0 To olit1.Count - 1
              a = a + 1
              kq(a, 1) = olit1.Getkey(i)
          Next i
          For i = 0 To olit.Count - 1
              a = a + 1
              kq(a, 1) = olit.Getkey(i)
          Next i
       Else
          For i = olit.Count - 1 To 0 Step -1
             a = a + 1
             kq(a, 1) = olit.Getkey(i)
          Next i
          For i = olit1.Count - 1 To 0 Step -1
             a = a + 1
             kq(a, 1) = olit1.Getkey(i)
          Next i
       End If
       Set olit = Nothing
       Set olit1 = Nothing
       sapxep = kq
End Function

Bạn ơi mình phát hiện ra một vấn đề đối với hàm của bạn là nó phân biệt chữ hoa chữ thường bạn nhé, bạn giúp mình sao cho hàm này lọc được ra những giá trị đại diện của một danh sách nhưng không phân biệt chữ hoa chữ thường với nhé, ví dụ danh sách gồm FA ; Fa ; fa thì kết quả của hàm thu được chỉ có một giá trị là đại diện, chẳng hạn như FA hoặc fa (hay Fa) thôi chứ hiện tại hàm của bạn trả về cả 3 giá trị FA ; Fa ; fa bạn nhé, bạn xem file mình đính kèm với nhé, mình cảm ơn bạn

snow25 · 24/9/19

hktanh đã viết:
Bạn ơi mình phát hiện ra một vấn đề đối với hàm của bạn là nó phân biệt chữ hoa chữ thường bạn nhé, bạn giúp mình sao cho hàm này lọc được ra những giá trị đại diện của một danh sách nhưng không phân biệt chữ hoa chữ thường với nhé, ví dụ danh sách gồm FA ; Fa ; fa thì kết quả của hàm thu được chỉ có một giá trị là đại diện, chẳng hạn như FA hoặc fa (hay Fa) thôi chứ hiện tại hàm của bạn trả về cả 3 giá trị FA ; Fa ; fa bạn nhé, bạn xem file mình đính kèm với nhé, mình cảm ơn bạn

Bạn thử mình chưa test nhé.Nhưng nó sẽ trả về dạng in hoa hết nhé.

Mã:

Function sapxep(ByVal mang As Range, ByVal so As Boolean)
       Dim T, dk As String, dks As Double, olit As Object, kq() As String, i As Long, a As Long, olit1 As Object
       Set olit1 = CreateObject("System.Collections.SortedList")
       Set olit = CreateObject("System.Collections.SortedList")
       For Each T In mang
         If IsNumeric(T.Value) And Len(T.Value) > 0 Then
            dks = T.Value
            If Not olit1.Contains(dks) Then
               olit1.Add dks, ""
            End If
         Else
            dk = UCase(T.Value)
            If Not olit.Contains(dk) Then
               olit.Add dk, ""
            End If
         End If
       Next
       ReDim kq(1 To mang.Count, 1 To 1)
       If so = True Then
          For i = 0 To olit1.Count - 1
              a = a + 1
              kq(a, 1) = olit1.Getkey(i)
          Next i
          For i = 0 To olit.Count - 1
              a = a + 1
              kq(a, 1) = olit.Getkey(i)
          Next i
       Else
          For i = olit.Count - 1 To 0 Step -1
             a = a + 1
             kq(a, 1) = olit.Getkey(i)
          Next i
          For i = olit1.Count - 1 To 0 Step -1
             a = a + 1
             kq(a, 1) = olit1.Getkey(i)
          Next i
       End If
       Set olit = Nothing
       Set olit1 = Nothing
       sapxep = kq
End Function

hktanh · 24/9/19

snow25 đã viết:

Bạn thử mình chưa test nhé.Nhưng nó sẽ trả về dạng in hoa hết nhé.

Mã:

Function sapxep(ByVal mang As Range, ByVal so As Boolean)
       Dim T, dk As String, dks As Double, olit As Object, kq() As String, i As Long, a As Long, olit1 As Object
       Set olit1 = CreateObject("System.Collections.SortedList")
       Set olit = CreateObject("System.Collections.SortedList")
       For Each T In mang
         If IsNumeric(T.Value) And Len(T.Value) > 0 Then
            dks = T.Value
            If Not olit1.Contains(dks) Then
               olit1.Add dks, ""
            End If
         Else
            dk = UCase(T.Value)
            If Not olit.Contains(dk) Then
               olit.Add dk, ""
            End If
         End If
       Next
       ReDim kq(1 To mang.Count, 1 To 1)
       If so = True Then
          For i = 0 To olit1.Count - 1
              a = a + 1
              kq(a, 1) = olit1.Getkey(i)
          Next i
          For i = 0 To olit.Count - 1
              a = a + 1
              kq(a, 1) = olit.Getkey(i)
          Next i
       Else
          For i = olit.Count - 1 To 0 Step -1
             a = a + 1
             kq(a, 1) = olit.Getkey(i)
          Next i
          For i = olit1.Count - 1 To 0 Step -1
             a = a + 1
             kq(a, 1) = olit1.Getkey(i)
          Next i
       End If
       Set olit = Nothing
       Set olit1 = Nothing
       sapxep = kq
End Function

ok bạn , có gì mình sẽ hỏi bạn thêm nhé :sweatdrop:

^^

hktanh · 24/9/19

hktanh đã viết:
ok bạn , có gì mình sẽ hỏi bạn thêm nhé ^^

snow25 đã viết:

Bạn thử mình chưa test nhé.Nhưng nó sẽ trả về dạng in hoa hết nhé.

Mã:

Function sapxep(ByVal mang As Range, ByVal so As Boolean)
       Dim T, dk As String, dks As Double, olit As Object, kq() As String, i As Long, a As Long, olit1 As Object
       Set olit1 = CreateObject("System.Collections.SortedList")
       Set olit = CreateObject("System.Collections.SortedList")
       For Each T In mang
         If IsNumeric(T.Value) And Len(T.Value) > 0 Then
            dks = T.Value
            If Not olit1.Contains(dks) Then
               olit1.Add dks, ""
            End If
         Else
            dk = UCase(T.Value)
            If Not olit.Contains(dk) Then
               olit.Add dk, ""
            End If
         End If
       Next
       ReDim kq(1 To mang.Count, 1 To 1)
       If so = True Then
          For i = 0 To olit1.Count - 1
              a = a + 1
              kq(a, 1) = olit1.Getkey(i)
          Next i
          For i = 0 To olit.Count - 1
              a = a + 1
              kq(a, 1) = olit.Getkey(i)
          Next i
       Else
          For i = olit.Count - 1 To 0 Step -1
             a = a + 1
             kq(a, 1) = olit.Getkey(i)
          Next i
          For i = olit1.Count - 1 To 0 Step -1
             a = a + 1
             kq(a, 1) = olit1.Getkey(i)
          Next i
       End If
       Set olit = Nothing
       Set olit1 = Nothing
       sapxep = kq
End Function

Bạn ơi, với thắc mắc lúc trước của mình, mình nghĩ ra một cách nâng cấp hàm sắp xếp của bạn như thế này, không biết bạn có giúp được mình không, giúp được thì tốt quá :sweatdrop:

Hàm sắp xếp cải tiến sẽ có 3 tham số =SapXep(Vùng cần sắp xếp ; cách sắp xếp (0 hoặc 1) ; định dạng của text khi có chuỗi trùng nhau, chỉ khác in hoa hay in thường)
Vùng cần sắp xếp, cách sắp xếp (0 ; 1) : Giống như cách làm lúc trước của bạn
Đối với các chuỗi chỉ xuất hiện một lần và có cách viết chữ hoa hay thường giống nhau, giữ nguyên định dạng cho từng chữ, ví dụ dãy AbcD ; AbcD ; AbcD thì kết quả của hàm sắp xếp vẫn là AbcD
Đối với các chuỗi chỉ xuất hiện một lần nhưng có cách viết chữ hoa chữ thường khác nhau, ví dụ: ABCd ; abcd ; abcD ; aBcd ta xem xét đến tham số thứ 3 - định dạng của text khi có chuỗi trùng nhau, chỉ khác in hoa hay in thường
Xét tham số thứ 3: định dạng của text khi có chuỗi trùng nhau, chỉ khác in hoa hay in thường
Nếu tham số thứ 3 = 0 hoặc không có: Lấy tất cả những giá trị đại diện bao gồm các chuỗi giống nhau, chỉ khác chữ hoa chữ thường, ví dụ dãy: AB ; Ab ; aB ; Ab ; AB thì kết quả của hàm sắp xếp sẽ là 3 chuỗi AB ; Ab ; ab
Nếu tham số thứ 3 = 1: Định dạng các chuỗi trùng nhau sẽ ở dạng in hoa toàn bộ (UPPER): ví dụ dãy: AB ; Ab ; aB ; Ab ; AB thì kết quả của hàm sắp xếp sẽ là chuỗi AB
Nếu tham số thứ 3 = 2: Định dạng các chuỗi trùng nhau sẽ ở dạng in thường toàn bộ (LOWER): ví dụ dãy: AB ; Ab ; aB ; Ab ; AB thì kết quả của hàm sắp xếp sẽ là chuỗi ab
Nếu tham số thứ 3 = 3: Định dạng các chuỗi trùng nhau sẽ ở dạng in hoa chữ cái đầu, các chữ sau viết thường (PROPER): ví dụ dãy: AB ; Ab ; aB ; Ab ; AB thì kết quả của hàm sắp xếp sẽ là chuỗi Ab
Nhắc lại: Đối với các chuỗi chỉ xuất hiện một lần và có cách viết chữ hoa hay thường giống nhau, giữ nguyên định dạng cho từng chữ, ví dụ dãy AbcD ; AbcD ; AbcD thì kết quả của hàm sắp xếp vẫn là AbcD bạn nhé :sweatdrop:

- Nếu hàm sắp xếp này có thể áp dụng được cho cả chuỗi gồm nhiều từ chẳng hạn như chuỗi "AbcD FghK" hay nhiều hơn nữa là chuỗi gồm 3 từ "AbcD FghK UopV" thì quá tốt bạn nhé :gathering:

Mong là bạn có thể giúp được mình ở hàm cải tiến có 3 tham số như mình đã trình bày

) còn nếu không được thì mình vẫn rất cảm ơn bạn vì những gì bạn đã giúp :gathering:

hktanh · 24/9/19

snow25 đã viết:

Bạn thử mình chưa test nhé.Nhưng nó sẽ trả về dạng in hoa hết nhé.

Mã:

Function sapxep(ByVal mang As Range, ByVal so As Boolean)
       Dim T, dk As String, dks As Double, olit As Object, kq() As String, i As Long, a As Long, olit1 As Object
       Set olit1 = CreateObject("System.Collections.SortedList")
       Set olit = CreateObject("System.Collections.SortedList")
       For Each T In mang
         If IsNumeric(T.Value) And Len(T.Value) > 0 Then
            dks = T.Value
            If Not olit1.Contains(dks) Then
               olit1.Add dks, ""
            End If
         Else
            dk = UCase(T.Value)
            If Not olit.Contains(dk) Then
               olit.Add dk, ""
            End If
         End If
       Next
       ReDim kq(1 To mang.Count, 1 To 1)
       If so = True Then
          For i = 0 To olit1.Count - 1
              a = a + 1
              kq(a, 1) = olit1.Getkey(i)
          Next i
          For i = 0 To olit.Count - 1
              a = a + 1
              kq(a, 1) = olit.Getkey(i)
          Next i
       Else
          For i = olit.Count - 1 To 0 Step -1
             a = a + 1
             kq(a, 1) = olit.Getkey(i)
          Next i
          For i = olit1.Count - 1 To 0 Step -1
             a = a + 1
             kq(a, 1) = olit1.Getkey(i)
          Next i
       End If
       Set olit = Nothing
       Set olit1 = Nothing
       sapxep = kq
End Function

bạn ơi, tình hình là không thể cải tiến được hàm sắp xếp này theo ý bên dưới của mình được à bạn

) tại là nếu cứ để chữ hoa hết thì không ổn chút nào bạn ạ, chẳng hạn như danh sách nguyên liệu gồm có nước, cát, đá dăm, fcpt01, fcpt02 thì bây giờ lại thành hết in hoa NƯỚC, CÁT, FCPT01, FCPT02, ĐÁ DĂM ,NHÌN DANH SÁCH IN HOA KIỂU NÀY RẤT KHÓ CHỊU BẠN Ạ

Bài đã được tự động gộp: 24/9/19

hktanh đã viết:
bạn ơi, tình hình là không thể cải tiến được hàm sắp xếp này theo ý bên dưới của mình được à bạn ) tại là nếu cứ để chữ hoa hết thì không ổn chút nào bạn ạ, chẳng hạn như danh sách nguyên liệu gồm có nước, cát, đá dăm, fcpt01, fcpt02 thì bây giờ lại thành hết in hoa NƯỚC, CÁT, FCPT01, FCPT02, ĐÁ DĂM ,NHÌN DANH SÁCH IN HOA KIỂU NÀY RẤT KHÓ CHỊU BẠN Ạ

snow25 đã viết:

Bạn thử mình chưa test nhé.Nhưng nó sẽ trả về dạng in hoa hết nhé.

Mã:

Function sapxep(ByVal mang As Range, ByVal so As Boolean)
       Dim T, dk As String, dks As Double, olit As Object, kq() As String, i As Long, a As Long, olit1 As Object
       Set olit1 = CreateObject("System.Collections.SortedList")
       Set olit = CreateObject("System.Collections.SortedList")
       For Each T In mang
         If IsNumeric(T.Value) And Len(T.Value) > 0 Then
            dks = T.Value
            If Not olit1.Contains(dks) Then
               olit1.Add dks, ""
            End If
         Else
            dk = UCase(T.Value)
            If Not olit.Contains(dk) Then
               olit.Add dk, ""
            End If
         End If
       Next
       ReDim kq(1 To mang.Count, 1 To 1)
       If so = True Then
          For i = 0 To olit1.Count - 1
              a = a + 1
              kq(a, 1) = olit1.Getkey(i)
          Next i
          For i = 0 To olit.Count - 1
              a = a + 1
              kq(a, 1) = olit.Getkey(i)
          Next i
       Else
          For i = olit.Count - 1 To 0 Step -1
             a = a + 1
             kq(a, 1) = olit.Getkey(i)
          Next i
          For i = olit1.Count - 1 To 0 Step -1
             a = a + 1
             kq(a, 1) = olit1.Getkey(i)
          Next i
       End If
       Set olit = Nothing
       Set olit1 = Nothing
       sapxep = kq
End Function
[/CODE
[QUOTE="snow25, post: 937240, member: 1166775"]
Bạn thử mình chưa test nhé.Nhưng nó sẽ trả về dạng in hoa hết nhé.
[CODE]Function sapxep(ByVal mang As Range, ByVal so As Boolean)
       Dim T, dk As String, dks As Double, olit As Object, kq() As String, i As Long, a As Long, olit1 As Object
       Set olit1 = CreateObject("System.Collections.SortedList")
       Set olit = CreateObject("System.Collections.SortedList")
       For Each T In mang
         If IsNumeric(T.Value) And Len(T.Value) > 0 Then
            dks = T.Value
            If Not olit1.Contains(dks) Then
               olit1.Add dks, ""
            End If
         Else
            dk = UCase(T.Value)
            If Not olit.Contains(dk) Then
               olit.Add dk, ""
            End If
         End If
       Next
       ReDim kq(1 To mang.Count, 1 To 1)
       If so = True Then
          For i = 0 To olit1.Count - 1
              a = a + 1
              kq(a, 1) = olit1.Getkey(i)
          Next i
          For i = 0 To olit.Count - 1
              a = a + 1
              kq(a, 1) = olit.Getkey(i)
          Next i
       Else
          For i = olit.Count - 1 To 0 Step -1
             a = a + 1
             kq(a, 1) = olit.Getkey(i)
          Next i
          For i = olit1.Count - 1 To 0 Step -1
             a = a + 1
             kq(a, 1) = olit1.Getkey(i)
          Next i
       End If
       Set olit = Nothing
       Set olit1 = Nothing
       sapxep = kq
End Function

sao cứ cười suốt thế

snow25 · 24/9/19

hktanh đã viết:
bạn ơi, tình hình là không thể cải tiến được hàm sắp xếp này theo ý bên dưới của mình được à bạn ) tại là nếu cứ để chữ hoa hết thì không ổn chút nào bạn ạ, chẳng hạn như danh sách nguyên liệu gồm có nước, cát, đá dăm, fcpt01, fcpt02 thì bây giờ lại thành hết in hoa NƯỚC, CÁT, FCPT01, FCPT02, ĐÁ DĂM ,NHÌN DANH SÁCH IN HOA KIỂU NÀY RẤT KHÓ CHỊU BẠN Ạ

Bài đã được tự động gộp: 24/9/19

sao cứ cười suốt thế

Vậy cho nó thành chữ thường hết hoặc viết hoa chữ đầu cũng được.Bạn sửa ở chỗ hàm Ucase() đó.

Mã:

dk = UCase(T.Value)

hktanh · 24/9/19

snow25 đã viết:
Vậy cho nó thành chữ thường hết hoặc viết hoa chữ đầu cũng được.Bạn sửa ở chỗ hàm Ucase() đó.

Mã:

dk = UCase(T.Value)

ừ bạn, rồi mình sẽ nghiên cứu hàm ucase xem , nhưng mà có cách nào để giữ được định dạng chữ hoa thường xen kẽ nhau của mấy cái chuỗi không bị lặp kiểu Ab aB không bạn nhỉ, mấy chuỗi không lặp kiểu Ab ; Ab ý, thì nó vẫn giữ nguyên là Ab --=--

(hơi buồn là mình không biết gì về vba

))

Bài đã được tự động gộp: 24/9/19

snow25 đã viết:
Vậy cho nó thành chữ thường hết hoặc viết hoa chữ đầu cũng được.Bạn sửa ở chỗ hàm Ucase() đó.

Mã:

dk = UCase(T.Value)

thôi được rồi, mình có cách nhưng mà phải dùng đến 2 cột mới ra được kết quả. có gì thắc mắc nữa mình hỏi snow25 tiếp nhé, thank you :gathering:

snow25 · 24/9/19

hktanh đã viết:
ừ bạn, rồi mình sẽ nghiên cứu hàm ucase xem , nhưng mà có cách nào để giữ được định dạng chữ hoa thường xen kẽ nhau của mấy cái chuỗi không bị lặp kiểu Ab aB không bạn nhỉ, mấy chuỗi không lặp kiểu Ab ; Ab ý, thì nó vẫn giữ nguyên là Ab
(hơi buồn là mình không biết gì về vba ))

Bài đã được tự động gộp: 24/9/19

thôi được rồi, mình có cách nhưng mà phải dùng đến 2 cột mới ra được kết quả. có gì thắc mắc nữa mình hỏi snow25 tiếp nhé, Cảm ơn

Được nhưng viết code nó khó hơn nên mình không viết.Bạn tìm hiểu đi nhé.

hktanh · 24/9/19

snow25 đã viết:
Được nhưng viết code nó khó hơn nên mình không viết.Bạn tìm hiểu đi nhé.

ok bạn, lần tới có thắc mắc gì về hàm thì mình sẽ hỏi bạn trên cùng cái topic này nhé, không được thì mình sẽ đăng bài lên topic mới

) mong bạn trả lời :icecream:

còn tạm thời thì mình biết cách sửa cái UCase thành LCase rồi

)

HieuCD · 24/9/19

hktanh đã viết:
Bạn ơi, với thắc mắc lúc trước của mình, mình nghĩ ra một cách nâng cấp hàm sắp xếp của bạn như thế này, không biết bạn có giúp được mình không, giúp được thì tốt quá
Hàm sắp xếp cải tiến sẽ có 3 tham số =SapXep(Vùng cần sắp xếp ; cách sắp xếp (0 hoặc 1) ; định dạng của text khi có chuỗi trùng nhau, chỉ khác in hoa hay in thường)
Vùng cần sắp xếp, cách sắp xếp (0 ; 1) : Giống như cách làm lúc trước của bạn
Đối với các chuỗi chỉ xuất hiện một lần và có cách viết chữ hoa hay thường giống nhau, giữ nguyên định dạng cho từng chữ, ví dụ dãy AbcD ; AbcD ; AbcD thì kết quả của hàm sắp xếp vẫn là AbcD
Đối với các chuỗi chỉ xuất hiện một lần nhưng có cách viết chữ hoa chữ thường khác nhau, ví dụ: ABCd ; abcd ; abcD ; aBcd ta xem xét đến tham số thứ 3 - định dạng của text khi có chuỗi trùng nhau, chỉ khác in hoa hay in thường
Xét tham số thứ 3: định dạng của text khi có chuỗi trùng nhau, chỉ khác in hoa hay in thường
Nếu tham số thứ 3 = 0 hoặc không có: Lấy tất cả những giá trị đại diện bao gồm các chuỗi giống nhau, chỉ khác chữ hoa chữ thường, ví dụ dãy: AB ; Ab ; aB ; Ab ; AB thì kết quả của hàm sắp xếp sẽ là 3 chuỗi AB ; Ab ; ab
Nếu tham số thứ 3 = 1: Định dạng các chuỗi trùng nhau sẽ ở dạng in hoa toàn bộ (UPPER): ví dụ dãy: AB ; Ab ; aB ; Ab ; AB thì kết quả của hàm sắp xếp sẽ là chuỗi AB
Nếu tham số thứ 3 = 2: Định dạng các chuỗi trùng nhau sẽ ở dạng in thường toàn bộ (LOWER): ví dụ dãy: AB ; Ab ; aB ; Ab ; AB thì kết quả của hàm sắp xếp sẽ là chuỗi ab
Nếu tham số thứ 3 = 3: Định dạng các chuỗi trùng nhau sẽ ở dạng in hoa chữ cái đầu, các chữ sau viết thường (PROPER): ví dụ dãy: AB ; Ab ; aB ; Ab ; AB thì kết quả của hàm sắp xếp sẽ là chuỗi Ab
Nhắc lại: Đối với các chuỗi chỉ xuất hiện một lần và có cách viết chữ hoa hay thường giống nhau, giữ nguyên định dạng cho từng chữ, ví dụ dãy AbcD ; AbcD ; AbcD thì kết quả của hàm sắp xếp vẫn là AbcD bạn nhé
- Nếu hàm sắp xếp này có thể áp dụng được cho cả chuỗi gồm nhiều từ chẳng hạn như chuỗi "AbcD FghK" hay nhiều hơn nữa là chuỗi gồm 3 từ "AbcD FghK UopV" thì quá tốt bạn nhé
Mong là bạn có thể giúp được mình ở hàm cải tiến có 3 tham số như mình đã trình bày ) còn nếu không được thì mình vẫn rất cảm ơn bạn vì những gì bạn đã giúp

Thử

Mã:

Function SapXepNew(ByVal Rng As Range, Optional ByVal ASC As Boolean = True, Optional ByVal TypeRes As Long = 0)
    Dim sArr, Res(), oSList As Object, oSList2 As Object, iKey, iKey2
    Dim sRow&, i&, k&
    
    Set oSList = CreateObject("System.Collections.SortedList")
    Set oSList2 = CreateObject("System.Collections.SortedList")
    If Rng.Rows.Count = 1 Then
      ReDim sArr(1 To 1, 1 To 1)
      sArr(1, 1) = Rng.Value
    Else
      sArr = Rng.Value
    End If
    sRow = UBound(sArr)
    For i = 1 To sRow
      iKey = sArr(i, 1)
      If Len(iKey) > 0 Then
        If IsNumeric(iKey) Then
          If Not oSList.Contains(iKey) Then oSList.Add iKey, ""
        Else
          If TypeRes = 0 Then
            iKey2 = iKey
          ElseIf TypeRes = 1 Then
            iKey2 = UCase(iKey)
          ElseIf TypeRes = 2 Then
            iKey2 = LCase(iKey)
          Else
            iKey2 = Application.Proper(iKey)
          End If
          If Not oSList2.Contains(iKey2) Then oSList2.Add iKey2, ""
        End If
      End If
    Next i

    ReDim Res(1 To sRow, 1 To 1)
    If ASC = True Then
      For i = 0 To oSList.Count - 1
        k = k + 1
        Res(k, 1) = oSList.Getkey(i)
      Next i
      For i = 0 To oSList2.Count - 1
        k = k + 1
        Res(k, 1) = oSList2.Getkey(i)
      Next i
    Else
      For i = oSList.Count - 1 To 0 Step -1
        k = k + 1
        Res(k, 1) = oSList.Getkey(i)
      Next i
      For i = oSList2.Count - 1 To 0 Step -1
        k = k + 1
        Res(k, 1) = oSList2.Getkey(i)
      Next i
    End If
    Set oSList = Nothing:    Set oSList2 = Nothing
    SapXepNew = Res
End Function

hktanh · 24/9/19

snow25 đã viết:
Được nhưng viết code nó khó hơn nên mình không viết.Bạn tìm hiểu đi nhé.

bạn ơi tình hình là sếp có vẻ ok với phương án hàm của bạn rồi nhé

) sau có gì mình sẽ hỏi thêm. Thực ra mình muốn hàm sắp xếp này ưu việt hơn chút vì thấy nhiều hàm sắp xếp trong mấy cái addin nó làm hay lắm, mỗi tội là phải mất tiền còn mình thì không muốn trả phí cho mấy cái addin đó

)

Bài đã được tự động gộp: 24/9/19

HieuCD đã viết:

Thử

Mã:

Function SapXepNew(ByVal Rng As Range, Optional ByVal ASC As Boolean = True, Optional ByVal TypeRes As Long = 0)
    Dim sArr, Res(), oSList As Object, oSList2 As Object, iKey, iKey2
    Dim sRow&, i&, k&
   
    Set oSList = CreateObject("System.Collections.SortedList")
    Set oSList2 = CreateObject("System.Collections.SortedList")
    If Rng.Rows.Count = 1 Then
      ReDim sArr(1 To 1, 1 To 1)
      sArr(1, 1) = Rng.Value
    Else
      sArr = Rng.Value
    End If
    sRow = UBound(sArr)
    For i = 1 To sRow
      iKey = sArr(i, 1)
      If Len(iKey) > 0 Then
        If IsNumeric(iKey) Then
          If Not oSList.Contains(iKey) Then oSList.Add iKey, ""
        Else
          If TypeRes = 0 Then
            iKey2 = iKey
          ElseIf TypeRes = 1 Then
            iKey2 = UCase(iKey)
          ElseIf TypeRes = 2 Then
            iKey2 = LCase(iKey)
          Else
            iKey2 = Application.Proper(iKey)
          End If
          If Not oSList2.Contains(iKey2) Then oSList2.Add iKey2, ""
        End If
      End If
    Next i

    ReDim Res(1 To sRow, 1 To 1)
    If ASC = True Then
      For i = 0 To oSList.Count - 1
        k = k + 1
        Res(k, 1) = oSList.Getkey(i)
      Next i
      For i = 0 To oSList2.Count - 1
        k = k + 1
        Res(k, 1) = oSList2.Getkey(i)
      Next i
    Else
      For i = oSList.Count - 1 To 0 Step -1
        k = k + 1
        Res(k, 1) = oSList.Getkey(i)
      Next i
      For i = oSList2.Count - 1 To 0 Step -1
        k = k + 1
        Res(k, 1) = oSList2.Getkey(i)
      Next i
    End If
    Set oSList = Nothing:    Set oSList2 = Nothing
    SapXepNew = Res
End Function

Bạn ơi, hàm của bạn trả về những ô không có giá trị thì toàn là số 0 , mình muốn nó là ô trống bạn nhé, bạn xem giúp mình file với, cảm ơn bạn nhiều :victory:

^^

Cần giúp hàm tự tạo sắp xếp mảng có phần tử rỗng ("")

Thành viên bị đình chỉ hoạt động

File đính kèm

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

Thành viên bị đình chỉ hoạt động

Thành viên bị đình chỉ hoạt động

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

Thành viên bị đình chỉ hoạt động

File đính kèm

Thành viên bị đình chỉ hoạt động

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

Thành viên bị đình chỉ hoạt động

Thành viên bị đình chỉ hoạt động

File đính kèm

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

Thành viên bị đình chỉ hoạt động

Thành viên bị đình chỉ hoạt động

Thành viên bị đình chỉ hoạt động

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

Thành viên bị đình chỉ hoạt động

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

Thành viên bị đình chỉ hoạt động

Chuyên gia GPE

Thành viên bị đình chỉ hoạt động

File đính kèm

Đếm ngược thời gian