|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
Option Explicit
Sub TEST1()
Dim ar, br, i&, j&, k&, iPosRow&
ar = Sheets(1).[A1].CurrentRegion.Value
For i = 2 To 3
With Sheets(i)
ReDim br(1 To UBound(ar), 1 To 4)
For k = 1 To UBound(ar): br(k, 1) = ar(k, 1): Next
iPosRow = 1
For j = i To UBound(ar, 2) Step 3
iPosRow = iPosRow + 1
For k = 1 To UBound(ar)
br(k, iPosRow) = ar(k, j)
Next k
Next j
.[A1].Resize(UBound(br), UBound(br, 2)) = br
End With
Next i
Beep
End Sub
Option Explicit
Sub TEST1()
Dim ar, br, i&, j&, k&, iPosRow&
ar = Sheets(1).[A1].CurrentRegion.Value
For i = 2 To 3
With Sheets(i)
ReDim br(1 To UBound(ar), 1 To 4)
For k = 1 To UBound(ar): br(k, 1) = ar(k, 1): Next
iPosRow = 1
For j = i To UBound(ar, 2) Step 3
iPosRow = iPosRow + 1
For k = 1 To UBound(ar)
br(k, iPosRow) = ar(k, j)
Next k
Next j
.[A1].Resize(UBound(br), UBound(br, 2)) = br
End With
Next i
Beep
End Sub
|
|