[已解决]怎么用VBA对A列数据根据字符长度来在D列排序出来

sanculans

怎么用VBA对A列数据根据字符长度来在D列排序出来
Book1.zip (24.97 KB, 下载次数: 31)

2012-5-16 22:03 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

lisachen

2012-5-16 22:26

1. 
   
2. Sub 选择排序()
   
3.   Dim arr, temp, x, y, t, iMax, k, k1, k2
   
4.   arr = Range("a1:a50")
   
5.   For x = UBound(arr) To 1 + 1 Step -1
   
6.      iMax = 1
   
7.      For y = 1 To x
   
8.           If Len(arr(y, 1)) > Len(arr(iMax, 1)) Then iMax = y
   
9.      Next y
   
10.      temp = arr(iMax, 1)
    
11.      arr(iMax, 1) = arr(x, 1)
    
12.      arr(x, 1) = temp
    
13.   Next x
    
14.   Range("d1").Resize(UBound(arr)) = ""
    
15.   Range("d1").Resize(UBound(arr)) = arr
    
16. End Sub
    

复制代码

跳转到最佳答案楼层

lisachen

1. 
   
2. Sub 选择排序()
   
3.   Dim arr, temp, x, y, t, iMax, k, k1, k2
   
4.   arr = Range("a1:a50")
   
5.   For x = UBound(arr) To 1 + 1 Step -1
   
6.      iMax = 1
   
7.      For y = 1 To x
   
8.           If Len(arr(y, 1)) > Len(arr(iMax, 1)) Then iMax = y
   
9.      Next y
   
10.      temp = arr(iMax, 1)
    
11.      arr(iMax, 1) = arr(x, 1)
    
12.      arr(x, 1) = temp
    
13.   Next x
    
14.   Range("d1").Resize(UBound(arr)) = ""
    
15.   Range("d1").Resize(UBound(arr)) = arr
    
16. End Sub
    

复制代码

sanculans

lisachen 发表于 2012-5-16 22:26

{:171:} 要是后面带说明就更好了，这样就容易理解学习了

sanculans

lisachen 发表于 2012-5-16 22:26

{:041:}那个顺序是从最长到最短怎么该，你这个是最短到最长的

lisachen

sanculans 发表于 2012-5-16 22:47
那个顺序是从最长到最短怎么该，你这个是最短到最长的

Sub 选择排序()
  Dim arr, temp, x, y, t, iMax, k, k1, k2
  arr = Range("a1:a50")
  For x = UBound(arr) To 1 + 1 Step -1
     iMax = 1
     For y = 1 To x
          If Len(arr(y, 1)) < Len(arr(iMax, 1)) Then iMax = y
     Next y
     temp = arr(iMax, 1)
     arr(iMax, 1) = arr(x, 1)
     arr(x, 1) = temp
  Next x
  Range("d1").Resize(UBound(arr)) = ""
  Range("d1").Resize(UBound(arr)) = arr
End Sub

1. 
   

复制代码

1. Sub 选择排序()
   
2. Dim arr, temp, x, y, t, iMax, k, k1, k2
   
3. arr = Range("a1:a50")
   
4. For x = UBound(arr) To 1 + 1 Step -1
   
5. iMax = 1
   
6. For y = 1 To x
   
7. If Len(arr(y, 1)) < Len(arr(iMax, 1)) Then iMax = y
   
8. Next y
   
9. temp = arr(iMax, 1)
   
10. arr(iMax, 1) = arr(x, 1)
    
11. arr(x, 1) = temp
    
12. Next x
    
13. Range("d1").Resize(UBound(arr)) = ""
    
14. Range("d1").Resize(UBound(arr)) = arr
    
15. End Sub

复制代码

ls

学习数组用法                              

auhl

学习一下，谢谢               

yiguo

学习了，多谢随缘版主，学习

bluexuemei

1. Sub ruby()
   
2. '须安装ACTIVERUBY.才能运行
   
3. '下载地址  http://www.artonx.org/data/asr/ActiveRuby.msi
   
4. Set ojs = CreateObject("scriptcontrol")
   
5. ojs.Language = "rubyscript"
   
6. ojs.eval "def aa(aa) $arr=aa.flatten! end"
   
7. y = ojs.Run("aa", Sheet3.Range("A1", Sheet3.[a65536].End(3)).Value)
   
8. y = ojs.eval("$arr.sort_by{|x|x.length}")
   
9. Sheet3.[d1].Resize(UBound(y) + 1, 1) = Application.Transpose(y)
   
10. End Sub

复制代码