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

976190982

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

Option Explicit

老师  能否向您请教一个问题，   在这段代码中   是怎么确定规格  这一排序依据的    因 有时候数据放的位置并不一样  所以我有时候想改

一把小刀闯天下

976190982 发表于 2020-7-15 10:00
老师  能否向您请教一个问题，   在这段代码中   是怎么确定规格  这一排序依据的    因 有时候数据放的 ...

需要规则，我只是给你加了一个条件而已，是否正确需要你去确认。代码按13楼的思路敲的，，，

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

修改15代码看一下输出就能看到规则的（用了3个辅助列）

[a2].Resize(UBound(arr, 1) - 1, 3) = arr  改成：

[a2].Resize(UBound(arr, 1) - 1, 6) = arr

976190982

一把小刀闯天下 发表于 2020-7-15 11:56
需要规则，我只是给你加了一个条件而已，是否正确需要你去确认。代码按13楼的思路敲的，，，

-------- ...

谢谢  老师   您的思路是对的  是我想要的   谢谢您的指点

976190982

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

Option Explicit

老师  我使用了很久    今天才发现  规格后面的数量没有跟着变，老师是否能帮我改一下，望您回复，想来也只有您比较对我这个问题有了解，希望得到您的帮助。
都怪我没有考虑到后续的使用情况，希望老师能给予帮助，谢谢
排序问题.zip (38.85 KB, 下载次数: 9)

2020-7-17 16:49 上传

点击文件名下载附件

一把小刀闯天下

976190982 发表于 2020-7-17 16:50
老师  我使用了很久    今天才发现  规格后面的数量没有跟着变，老师是否能帮我改一下，望您回复，想来也 ...

‘当时没有D、E这2列，稍作修改，先测试一下，，，

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(, 8).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, 6) = left(arr(i, 3), j)
        arr(i, 7) = Mid(arr(i, 3), j + 1)
        If dic.exists(arr(i, 7)) Then
          arr(i, 8) = dic(arr(i, 7))
        Else
          If IsNumeric(arr(i, 7)) Then
            arr(i, 8) = Val(arr(i, 7))
          Else
            arr(i, 8) = arr(i, 7)
          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, 6) <> arr(j + 1, 6) Or j = i Then
          Call bsort(arr, p + 1, j, 1, UBound(arr, 2), 8)
          p = j
        End If
      Next
      p = i
    End If
  Next
  [a2].Resize(UBound(arr, 1) - 1, 5) = 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

976190982

一把小刀闯天下 发表于 2020-7-17 20:04
‘当时没有D、E这2列，稍作修改，先测试一下，，，

Option Explicit

谢谢老师    给你添加麻烦了    我测试一下   万分感谢您的回复   谢谢您

大镁铝

zpy2 发表于 2020-7-13 19:46
select 货号,规格,条码 from (Select *,regexp2('^[^A-Z]+',规格) a,regexp2('[A-Z]+',规格) b from 货号 ...

不会玩

大镁铝

zpy2 发表于 2020-7-13 19:46
select 货号,规格,条码 from (Select *,regexp2('^[^A-Z]+',规格) a,regexp2('[A-Z]+',规格) b from 货号 ...

大神快来         看我的图片，咋不行呀，晕倒，大神的手机多少银子买的啊，不肯玩电脑

zpy2

大镁铝 发表于 2020-7-17 21:39
大神快来         看我的图片，咋不行呀，晕倒，大神的手机多少银子买的啊，不肯玩电脑

大神，电脑太贵，我买不起啊。。。
这个 regexp2是我在php 封装的一个自定义函数，只能在线或者网抓使用，ado 是不支持的。。。

大镁铝

zpy2 发表于 2020-7-18 07:22
大神，电脑太贵，我买不起啊。。。
这个 regexp2是我在php 封装的一个自定义函数，只能在线或者网抓使用 ...

大神说笑了，现在电脑比手机便宜，我本来想买个p40pro,太贵了，比我买的电脑还贵200,听说像素不好给又退了，网抓我不会，越来越觉得啥都不会，又懒