返回列表 上一主題 發帖

[發問] 自動增加列問題2

Sub TEST()
Dim R&, Arr, Brr, SS&, N&, i&, j&
[H:J].ClearContents
R = Cells(Rows.Count, 1).End(xlUp).Row
Arr = Range("A1:E" & R)
SS = Application.Sum([E:E])
ReDim Brr(1 To SS, 1 To 3)
For i = 1 To UBound(Arr)
  For j = Arr(i, 3) To Arr(i, 4)
    N = N + 1
    Brr(N, 1) = Arr(i, 1)
    Brr(N, 2) = Arr(i, 2)
    Brr(N, 3) = j
  Next j
Next

[H1:J1].Resize(SS) = Brr
End Sub
 
Xl0000010.rar (11.69 KB)
 

TOP

        靜思自在 : 得理要饒人,理直要氣和。
返回列表 上一主題