excel多列按行排序，vba代码，老师们帮忙看看！

sxjpf2119

excel多列按行排序，vba代码，老师们帮忙看看！
VBA多列按每一行数字从小到大排序
  

下面是附件：
vba多列按行重新排序.zip (10.52 KB, 下载次数: 122)

2018-8-16 08:34 上传

点击文件名下载附件

microyip

把数据读入数组，对每行数据进行排序即可

microyip

1. Sub 排序()
   
2.     Dim vData As Variant, nRow As Integer, nCol As Integer, vTmp As Variant
   
3.    
   
4.     vData = [A3:E13].Value
   
5.     For nRow = 1 To UBound(vData)
   
6.         vTmp = FastSort(Application.WorksheetFunction.Index(vData, nRow))
   
7.         For nCol = 1 To UBound(vData, 2)
   
8.             vData(nRow, nCol) = vTmp(nCol)
   
9.         Next
   
10.     Next
    
11.     [G3:K13] = vData
    
12. End Sub
    
13. Private Function FastSort(ByVal vData As Variant) As Variant
    
14.     Dim nI As Double, nJ As Double, vTmp As Variant
    
15.    
    
16.     nJ = LBound(vData)
    
17.     For nI = LBound(vData) To UBound(vData) - 1
    
18.         If Val(vData(nI)) <= Val(vData(nI + 1)) Then
    
19.             If nI > nJ Then
    
20.                 nJ = nI
    
21.             Else
    
22.                 nI = nJ
    
23.             End If
    
24.         Else
    
25.             vTmp = Val(vData(nI))
    
26.             vData(nI) = Val(vData(nI + 1))
    
27.             vData(nI + 1) = vTmp
    
28.             If nI <> LBound(vData) Then nI = nI - 2
    
29.         End If
    
30.     Next nI
    
31.     FastSort = vData
    
32. End Function

复制代码

microyip

附上附件以供参考

sxjpf2119

microyip 发表于 2018-8-16 08:43
把数据读入数组，对每行数据进行排序即可

老师，麻烦您给写下好吗？我是小白，谢谢老师！

zhenghui13

只会最简单的Bubble Sort,看一下是否是需要的效果。

1. Sub zz()
   
2. Dim t
   
3. Dim arr, i&, j&, x&, y&, k
   
4. Dim vSwap
   
5. t = Timer
   
6. 'arr = [a1].CurrentRegion.Value
   
7. arr = [a3].CurrentRegion.Value
   
8. x = UBound(arr, 2): y = UBound(arr)
   
9. ReDim brr(1 To y, 1 To x)
   
10. For i = 1 To y
    
11.   For j = 1 To x
    
12.     brr(i, j) = Val(arr(i, j))
    
13.   Next
    
14. Next
    
15. 'For i = 1 To y
    
16. '  k = Application.Index(arr, i, 0)
    
17. '  For j = 1 To x
    
18. '    brr(i, j) = Application.Small(k, j)
    
19. '  Next
    
20. 'Next
    
21. For i = 1 To y
    
22.     For j = 1 To x
    
23.         For k = j + 1 To x
    
24.             If brr(i, j) > brr(i, k) Then vSwap = brr(i, j): brr(i, j) = brr(i, k): brr(i, k) = vSwap
    
25.         Next k
    
26.     Next j
    
27. Next i
    
28. [g3].Resize(y, x) = brr
    
29. Debug.Print Timer - t
    
30. End Sub

复制代码

zhenghui13

代码审核中，效果如下

sxjpf2119

microyip 发表于 2018-8-16 08:58
附上附件以供参考

谢谢老师，简洁不简单

sxjpf2119

zhenghui13 发表于 2018-8-16 09:00
代码审核中，效果如下

谢谢老师，辛苦了

不知道为什么

sxjpf2119 发表于 2018-8-16 09:06
谢谢老师，简洁不简单

数据量不大，这样也可以：