[已解决]按字数多少排序的VBA

KDZ

请问大侠：如何用VBA实现按单元格内的字数多少排序？谢谢！

最佳答案

月排行榜 / 总排行榜

qh8600

2014-10-19 19:33

KDZ 发表于 2014-10-19 19:18
请问怎么搞法？

1. Sub demo()
   
2.     Dim arr, temp, x, y, t, k, i, a
   
3.     a = Sheet1.Cells(Rows.Count, 2).End(xlUp).Row
   
4.     arr = Range("a2:b" & a)
   
5.     For x = 1 To UBound(arr) - 1
   
6.         For y = x + 1 To UBound(arr)
   
7.             For i = 1 To 2
   
8.                 If Len(arr(x, 2)) < Len(arr(y, 2)) Then
   
9.                     temp = arr(x, i)
   
10.                     arr(x, i) = arr(y, i)
    
11.                     arr(y, i) = temp
    
12.                 End If
    
13.             Next
    
14.         Next
    
15.     Next
    
16.     Range("d2").Resize(x, 2) = ""
    
17.     Range("d2").Resize(x, 2) = arr
    
18. End Sub

复制代码

Book1.rar (10.01 KB, 下载次数: 18)

2014-10-19 19:33 上传

点击文件名下载附件
楼主试试

跳转到最佳答案楼层

上清宫主

加个辅助列算长度，按这个排序不就成了？

KDZ

上清宫主 发表于 2014-10-19 19:17
加个辅助列算长度，按这个排序不就成了？

请问怎么搞法？

qh8600

KDZ 发表于 2014-10-19 19:18
请问怎么搞法？

1. Sub demo()
   
2.     Dim arr, temp, x, y, t, k, i, a
   
3.     a = Sheet1.Cells(Rows.Count, 2).End(xlUp).Row
   
4.     arr = Range("a2:b" & a)
   
5.     For x = 1 To UBound(arr) - 1
   
6.         For y = x + 1 To UBound(arr)
   
7.             For i = 1 To 2
   
8.                 If Len(arr(x, 2)) < Len(arr(y, 2)) Then
   
9.                     temp = arr(x, i)
   
10.                     arr(x, i) = arr(y, i)
    
11.                     arr(y, i) = temp
    
12.                 End If
    
13.             Next
    
14.         Next
    
15.     Next
    
16.     Range("d2").Resize(x, 2) = ""
    
17.     Range("d2").Resize(x, 2) = arr
    
18. End Sub

复制代码

Book1.rar (10.01 KB, 下载次数: 18)

2014-10-19 19:33 上传

点击文件名下载附件
楼主试试

baksy

函数解决

su45

用辅助列做不用求人，更方便！

xdragon

1. Sub test()
   
2.    Dim conn As Object
   
3.    Set conn = CreateObject("Adodb.connection")
   
4.    conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 8.0;HDR=No;IMEX=1"";"
   
5.    Range("D2").CopyFromRecordset conn.Execute("select * from [Sheet1$A2:B] order by len(F2) desc")
   
6.    conn.Close
   
7.    Set conn = Nothing
   
8. End Sub

复制代码

我也参与下

KDZ

谢谢各位大师。