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

976190982

一把小刀闯天下 发表于 2020-7-13 19:38
目测A列有序，而且颜色跟A列有关，那就假设A列有序就可以了

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

老师    多运行几次   就会这样   而且运行第二次后就是这样子   有时候没有反应的 我也很疑惑 ，   颜色全部乱了

ggmmlol

1. Sub test()
   
2.     With Range("A1").CurrentRegion.Resize(, 4)
   
3.         ar = .Value
   
4.         For i = 2 To UBound(ar)
   
5.             lb = LenB(ar(i, 3))
   
6.             l = Len(ar(i, 3))
   
7.             s = Mid(ar(i, 3), lb - l + 1)
   
8.             If Not IsNumeric(s) Then
   
9.                 s = Application.Match(s, [{"XS","S","M","L","XL","2XL","3XL"}], 0)
   
10.             End If
    
11.             ar(i, 4) = s
    
12.         Next
    
13.         .Value = ar
    
14.         .Sort .Cells(1), , .Cells(4), , , .Cells(3), , xlYes
    
15.         .Columns(4).Clear
    
16.     End With
    
17. End Sub

复制代码

一把小刀闯天下

976190982 发表于 2020-7-14 09:16
老师    多运行几次   就会这样   而且运行第二次后就是这样子   有时候没有反应的 我也很疑惑 ，   颜色 ...

一楼你提供的附件中相同货号为同色，但图中并不是这样的

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

觉得你的条件应该是这样的：
1、相同货号作为一个数据区，本来有序作一下简单判断就可以
2、同一数据区中按规格列颜色再分区，这样颜色块就不会跑来跑去了（需要确定）
3、分区后再按“XS,S,M,L,XL,2XL，3XL,4XL“顺序排序

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

条件先要确认好，当然还得要上附件，，，

rym9401

不知道表述清楚否

一把小刀闯天下

'给你加了一个条件，就是13楼的，，，

Option Explicit

Sub test()
  Dim arr, i, j, 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(, 6).Value
  For i = 1 To UBound(arr, 1) - 1
    For j = Len(arr(i, 3)) To 1 Step -1
      If Asc(Mid(arr(i, 3), j, 1)) < 0 Then
        arr(i, 4) = left(arr(i, 3), j)
        arr(i, 5) = Mid(arr(i, 3), j + 1)
        If dic.exists(arr(i, 5)) Then
          arr(i, 6) = dic(arr(i, 5))
        Else
          If IsNumeric(arr(i, 5)) Then
            arr(i, 6) = Val(arr(i, 5))
          Else
            arr(i, 6) = arr(i, 5)
          End If
        End If
        Exit For
      End If
    Next
  Next
  For i = 1 To UBound(arr, 1) - 1
    If arr(i, 1) <> arr(i + 1, 1) Then
      For j = p + 1 To i
        If arr(j, 4) <> arr(j + 1, 4) Or j = i Then
          Call bsort(arr, p + 1, j, 1, UBound(arr, 2), 6)
          p = j
        End If
      Next
      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

CLL1998

设置了一个用于排序的排序编码，对排序编码按降序排序即可


   排序编码=货码10000+色码10+型码
  其中： 货码就是货号的数字部分，色码就是条码中数字后的首个英文字母的CODE()函数，型码就是衣服号型（XS,S,M,L,XL,2XL,3XL,4XL）的人为编码。就本例而言用函数MATCH()定义。
   为便于理解，保留了辅助列。

排序问题.rar (17.23 KB, 下载次数: 5)

2020-7-14 20:08 上传

点击文件名下载附件

976190982

rym9401 发表于 2020-7-14 14:50
不知道表述清楚否

谢谢老师的回复    这个很清楚  其实我是想vba来实现

976190982

一把小刀闯天下 发表于 2020-7-14 14:49
一楼你提供的附件中相同货号为同色，但图中并不是这样的

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

抱歉   老师  是我没有表述清楚

同色同号有序排列    XS,S,M,L,XL,2XL，3XL,4XL


排序问题.zip (23.96 KB, 下载次数: 1)

2020-7-15 09:17 上传

点击文件名下载附件

976190982

一把小刀闯天下 发表于 2020-7-14 15:19
'给你加了一个条件，就是13楼的，，，

Option Explicit

谢谢  老师   非常感谢

976190982

sencak 发表于 2020-7-13 14:48
Range("a2:c" & Cells(Rows.Count, 1).End(3).Row).Sort , 1, [c2], , 1, , , , , , 1, 1

谢谢老师的回复