排序问题，内容是文本+字母 ，按照字母的指定顺序排序

976190982

描述：c列的规格数据排序根据A列相同内容排序规则顺序为：XS,S,M,L,XL,2XL,3XL,4XL


捣鼓了半天，就是达不到想要的结果，只能求老师们用代码解决了 ，求老师们帮我，我用自定义序列，搞了好久，就是不成。




排序问题.zip (12.32 KB, 下载次数: 32)

2020-7-13 14:03 上传

点击文件名下载附件

谢谢老师们的回复    尤其是   一把小刀闯天下   老师   我的问题没有描述清楚   感谢老师

sencak

Range("a2:c" & Cells(Rows.Count, 1).End(3).Row).Sort [b2], 1, [c2], , 1, , , , , , 1, 1

蓝桥玄霜

排序问题的例子：

一把小刀闯天下

'A列可以无序，，，

Option Explicit

Sub test()
  Dim arr, i, p, dic
  Set dic = CreateObject("scripting.dictionary")
  arr = Split("XS,S,M,L,XL,2XL,3XL,4XL", ",")
  For i = 0 To UBound(arr)
    dic(arr(i)) = i - 20
  Next
  arr = [a1].CurrentRegion.Offset(1).Resize(, 5).Value
  For i = 1 To UBound(arr, 1) - 1
    If InStr(arr(i, 2), "A") Then
      p = InStr(arr(i, 2), "A")
    ElseIf InStr(arr(i, 2), "B") Then
      p = InStr(arr(i, 2), "B")
    ElseIf InStr(arr(i, 2), "C") Then
      p = InStr(arr(i, 2), "C")
    End If
    If p > 0 Then arr(i, 4) = Mid(arr(i, 2), p + 1) Else arr(i, 4) = 0
    If dic.exists(arr(i, 4)) Then
      arr(i, 5) = dic(arr(i, 4))
    Else
      arr(i, 5) = Val(arr(i, 4))
    End If
    p = 0
  Next
  Call bsort(arr, 1, UBound(arr, 1) - 1, 1, UBound(arr, 2), 1)
  For i = 1 To UBound(arr, 1) - 1
    If arr(i, 1) <> arr(i + 1, 1) Then
      Call bsort(arr, p + 1, i, 1, UBound(arr, 2), 5)
      p = i
    End If
  Next
  [a2].Resize(UBound(arr, 1) - 1, 3) = arr
End Sub

Function bsort(arr, first, last, left, right, key)
  Dim i, j, k, t
  For i = first To last - 1
    For j = first To last + first - 1 - i
      If arr(j, key) > arr(j + 1, key) Then
        For k = left To right
          t = arr(j, k): arr(j, k) = arr(j + 1, k): arr(j + 1, k) = t
        Next
      End If
    Next
  Next
End Function

shenjianrong163

1. Sub test()
   
2.     Dim i&, j&, m&, n&, d1, d2, k, reg, st, temp, arr
   
3.     Set d1 = CreateObject("Scripting.Dictionary")
   
4.     Set d2 = CreateObject("Scripting.Dictionary")
   
5.     Set reg = CreateObject("VBScript.RegExp")
   
6.     st = Split("XS,S,M,L,XL,2XL,3XL,4XL", ",")
   
7.     For i = 0 To UBound(st)
   
8.         d1(st(i)) = i + 1
   
9.     Next
   
10.     d1("") = 0
    
11.     With reg
    
12.         .Pattern = "[\u4e00-\u9fa5]*(.*)"
    
13.         .Global = True
    
14.     End With
    
15.     With Sheets("Sheet1")
    
16.         arr = .Range("A2:C" & .Cells(.Rows.Count, 1).End(xlUp).Row)
    
17.         For i = 1 To UBound(arr)
    
18. '            arr(i, 3) = reg.Replace(arr(i, 3), "$1")
    
19.             d2(arr(i, 1)) = d2(arr(i, 1)) + 1
    
20.         Next
    
21.         i = 1
    
22.         For Each k In d2.Keys
    
23.             If d2(k) > 1 Then
    
24.                 For m = i To i + d2(k) - 2
    
25.                     For n = m + 1 To i + d2(k) - 1
    
26.                         If d1(reg.Replace(arr(m, 3), "$1")) > d1(reg.Replace(arr(n, 3), "$1")) Then
    
27.                             For j = 1 To 3
    
28.                                 temp = arr(m, j): arr(m, j) = arr(n, j): arr(n, j) = temp
    
29.                             Next
    
30.                         End If
    
31.                     Next
    
32.                 Next
    
33.             End If
    
34.             i = i + d2(k)
    
35.         Next
    
36.         .[A2].Resize(UBound(arr), UBound(arr, 2)) = arr
    
37.     End With
    
38. End Sub

复制代码

shenjianrong163

请参考附件：


排序问题.rar (17.92 KB, 下载次数: 9)

2020-7-13 15:59 上传

点击文件名下载附件

976190982

shenjianrong163 发表于 2020-7-13 15:58

谢谢老师的回复，尺码虽然实现是    但是  同一个款的颜色打乱了

976190982

一把小刀闯天下 发表于 2020-7-13 15:11
'A列可以无序，，，

Option Explicit

谢谢老师的回复，尺码虽然实现是    但是  同一个款的颜色打乱了

一把小刀闯天下

976190982 发表于 2020-7-13 16:18
谢谢老师的回复，尺码虽然实现是    但是  同一个款的颜色打乱了

目测A列有序，而且颜色跟A列有关，那就假设A列有序就可以了

--------------

把这行删除：  Call bsort(arr, 1, UBound(arr, 1) - 1, 1, UBound(arr, 2), 1)

zpy2

976190982 发表于 2020-7-13 16:18
谢谢老师的回复，尺码虽然实现是    但是  同一个款的颜色打乱了

select 货号,规格,条码 from (Select *,regexp2('^[^A-Z]+',规格) a,regexp2('[A-Z]+',规格) b from 货号规格条码明细表2) order by 货号,a,instr(',S,M,L,XL',','||b)
这样子？
分裂字段后 在 多字段 自定义排序