|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
Option Explicit
Sub TEST2()
Dim ar(1 To 2), br, cr, i&, j&, k&, r&
Application.ScreenUpdating = False
br = [J1:K1].Value
For i = 1 To UBound(ar)
ar(i) = Range(Cells(1, (i - 1) * 6 + 3), Cells(Rows.Count, (i - 1) * 6 + 3).End(xlUp)).Value
ReDim cr(1 To UBound(ar(i)) * br(1, i), 0)
r = 0
For k = 1 To UBound(ar(i))
For j = 1 To br(1, i)
r = r + 1
cr(r, 0) = ar(i)(k, 1)
Next j
Next k
Columns(i + 11).Clear
Cells(1, i + 11).Resize(UBound(cr)) = cr
Next i
Application.ScreenUpdating = True
Beep
End Sub |
|