|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
参与一下。。。- Sub ykcbf() '//2024.2.25
- r = Me.Cells(Rows.Count, 1).End(3).Row
- arr = Me.Range("a1:g" & r + 1)
- ReDim brr(1 To UBound(arr) / 3, 1 To UBound(arr, 2))
- For i = 1 To UBound(arr) Step 3
- m = m + 1
- For j = 1 To UBound(arr, 2)
- brr(m, j) = arr(i + 1, j)
- Next
- Next
- Call px(brr, 7)
- m = 0
- For i = 1 To r Step 3
- m = m + 1
- For j = 1 To 7
- Me.Cells(i + 1, j) = brr(m, j)
- Next
- Next
- End Sub
- Function px(arr As Variant, col As Integer) As Variant
- Dim i As Long, j As Long, temp As Variant
- Dim r As Long, c As Long
- r = UBound(arr, 1)
- c = UBound(arr, 2)
- For i = 1 To r - 1
- For j = 1 To r - i
- If arr(j, col) > arr(j + 1, col) Then
- For k = 1 To c
- temp = arr(j, k)
- arr(j, k) = arr(j + 1, k)
- arr(j + 1, k) = temp
- Next k
- End If
- Next j
- Next i
- px = arr
- End Function
复制代码
|
评分
-
1
查看全部评分
-
|