Để tối về mình viết thêm hàm cho trường hợp nhãn size nha bạn
Dữ liệu của bạn kiểu Text mà Sort theo yêu cầu rất khó.
Function ReverseSize(ByVal sText As String) As String
'// like zSize '
Dim a As Variant, b As Variant, i As Long
a = Array("Size_2T", "Size_3T", "Size_4", "Size_5", "Size_6", "Size_7", "Size_XXS", "Size_XS", "Size_S", "Size_M", "Size_L", "Size_XL", "Size_2XL", "Size_3XL", "Size_4XL", "Size_5XL")
b = Array("Size_NTH01", "Size_NTH02", "Size_NTH03", "Size_NTH04", "Size_NTH05", "Size_NTH06", "Size_NTH07", "Size_NTH08", "Size_NTH09", "Size_NTH10", "Size_NTH11", "Size_NTH12", "Size_NTH13", "Size_NTH14", "Size_NTH15", "Size_NTH16")
For i = LBound(b) To UBound(b)
sText = Replace(sText, b(i), a(i))
Next i
ReverseSize = sText
End FunctionLâu rồi không dùng SortList, viết code để nhớ lệnh
Sub Sort_VatTu()
Dim sList As Object, sArr(), Size(), Res()
Dim sR As Long, i As Long, sKey As String, j As Long
Const sMatch As String = """"
Const zSize As String = "*Size_*"
Size = Array("Size_2T", "Size_3T", "Size_XS", "Size_XXS", "Size_S", "Size_M", "Size_L", "Size_XL", "Size_2XL", "Size_3XL", "Size_4", "Size_4XL", "Size_5", "Size_5XL", "Size_6", "Size_7")
Set sList = CreateObject("System.Collections.ArrayList")
With Sheets("Sheet1")
sArr = .Range("A4", .Range("C" & Rows.Count).End(xlUp)).Value '<--- vung du lieu can xu ly'
sR = UBound(sArr, 1)
For i = 1 To sR
Key = sArr(i, 2)
If Len(Key) Then
If InStr(Key, """") Then Key = ReplaceLenght(Key, sMatch)
If Key Like zSize Then
For j = LBound(Size) To UBound(Size)
If InStr(Key, Size(j)) Then Key = Replace(Key, Replace(Size(j), "Size_", ""), Format(j, "0000")): Exit For
Next j
End If
TroLai:
If Not sList.Contains(Key) Then
sList.Add Key
Else
Key = Key & " "
GoTo TroLai
End If
sArr(i, 1) = Key
End If
Next i
sList.Sort
ReDim Res(1 To sList.Count, 1 To 3)
For i = 0 To sList.Count - 1
idx = sList.InDexOf(sArr(i + 1, 1), 0)
Res(idx + 1, 1) = idx + 1
Res(idx + 1, 2) = sArr(i + 1, 2)
Res(idx + 1, 3) = sArr(i + 1, 3)
Next i
.Range("E4").Resize(sR, 3).Value = Res
End With
End Sub
Function ReplaceLenght(ByVal sText As String, ByVal sMatch As String) As String
'// like "*" & sMatch '
Dim aTmp
sText = Trim(sText)
aTmp = Split(sText, "_")
If UBound(aTmp) > 0 Then
sText = aTmp(UBound(aTmp))
sText = Replace(sText, sMatch, "")
sText = Replace(sText, ",", ".") 'Dâu phây tai cell [B20]'
sText = Format(Val(sText), "0##.0") & sMatch
aTmp(UBound(aTmp)) = sText
End If
sText = Join(aTmp, "_")
ReplaceLenght = sText
End Function Size = Array("Size_2T", "Size_3T", "Size_4", "Size_5", "Size_6", "Size_7", "Size_XXS", "Size_XS", "Size_S", "Size_M", "Size_L", "Size_XL", "Size_2XL", "Size_3XL", "Size_4XL", "Size_5XL")Chỉnh lại dòng lệnh
If Key Like zSize Then
For j = UBound(Size) To LBound(Size) Step -1
If InStr(Key, Size(j)) Then Key = Replace(Key, Replace(Size(j), "Size_", ""), Format(j, "0000")): Exit For
Next j
End If
