先排字母后排数字的顺序

张雄友

yaozong 发表于 2015-1-15 21:05
测试附件。。。。。。

请问第15句的：k = 3 - Len(a) 中的 3 是什么意思？

yaozong

张雄友 发表于 2015-1-15 21:11
请问第15句的：k = 3 - Len(a) 中的 3 是什么意思？

假定字母最多位数是3

如果最多位数是5时
k =5 - Len(a)

yaozong

重新整理如下：

Sub 先排字母后排数字() ''字母不分大小写
  Application.ScreenUpdating = False
  Dim arr, s$, a$, b&, i&, k&, m&, n&
  arr = Range("a1", [a65536].End(3))
  m = UBound(arr)
  For i = 1 To m
    s = arr(i, 1)
    For n = 1 To Len(s)
       If IsNumeric(Mid(s, n, 1)) Then
          a = Left(s, n - 1)
          b = Val(Mid(s, n)) + 10000000 ''数字最多暂定7位
          Exit For
       End If
    Next
    k = 4 - Len(a) ''字母最多暂定4位
    arr(i, 1) = a & String(k, "@") & b & "$" & s
  Next
  [h1].Resize(m) = arr
  [h1].Resize(m).Sort [h1], 1
  [h1].Resize(m).Replace "*$", ""
  Application.ScreenUpdating = True
End Sub

张雄友

yjh_27 发表于 2015-1-15 20:32
忽略大小写后
视为相同，排序随机

忽略大小写不对。前几个单元格。

张雄友

yaozong 发表于 2015-1-15 21:29
重新整理如下：

Sub 先排字母后排数字() ''字母不分大小写

怎么实现效果？

yjh_27

张雄友 发表于 2015-1-15 22:48
忽略大小写不对。前几个单元格。

已修复，请测试。

yaozong

张雄友 发表于 2015-1-16 07:48
怎么实现效果？

Sub 先排字母后排数字2() ''字母不分大小写
  Application.ScreenUpdating = False
  Dim arr, s$, a$, b&, i&, k&, m&, n&
  arr = Range("a1", [a65536].End(3))
  m = UBound(arr)
  For i = 1 To m
    s = arr(i, 1)
    For n = Len(s) To 1 Step -1
       If Mid(s, n, 1) Like "[a-zA-Z]" Then
          a = Left(s, n)
          b = Val(Mid(s, n + 1)) + 10000000
          Exit For
       End If
    Next
    k = 10 - Len(a)
    arr(i, 1) = a & String(k, "@") & b & "$" & s
  Next
  [k1].Resize(m) = arr
  [k1].Resize(m).Sort [k1], 1
  [k1].Resize(m).Replace "*$", ""
  Application.ScreenUpdating = True
End Sub

bluexuemei

1. Sub test()‘忽略大小写
   
2. '需要安装ACTIVERUBY ，下载地址 http://www.artonx.org/data/asr/Ruby-2.1.1.msi
   
3. Set ojs = CreateObject("Scriptcontrol"): ojs.Language = "rubyscript"
   
4. ojs.eval ("def aa(aa) $aa=aa.flatten end")
   
5. y = ojs.Run("aa", Range("A1", [a1].End(4)).Value)
   
6. y = ojs.eval("$aa.sort_by{|x|a=x.split(/(\d+)/);[a[0].upcase,a[1].to_i]}.zip")
   
7. [c1].Resize(UBound(y) + 1) = y
   
8. 'Stop
   
9. End Sub

复制代码

香川群子

笨 蛋 张雄友

我帮你写了自定义函数你都不会用。

那就看附件吧。

Zamyi

1. Sub test()
   
2. n = [a65536].End(3).Row
   
3. r = Range("a1:a" & n)
   
4. With CreateObject("VBScript.RegExp")
   
5.   .Global = True
   
6.   .Pattern = "\D+"
   
7.   For i = 1 To n
   
8.     s = .Replace(r(i, 1), "")
   
9.     r(i, 1) = Replace(r(i, 1), s, Format(s, "00000"))
   
10.   Next
    
11.   [b1].Resize(n) = r
    
12.   Range("a1:b" & n).Sort [b1]
    
13.   [b:b] = ""
    
14. End With
    
15. End Sub

复制代码