答案 0 :(得分:3)
此代码新工作表添加并输出结果。
Sub test()
Dim vDB, vR()
Dim Ws As Worksheet
Dim r As Long, c As Long
Dim i As Long, n As Long, j As Integer
Set Ws = ActiveSheet
With Ws
r = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
c = .Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
'vDB = .Range("a1", .Cells(r, c))
vDB = .Range("b1", "j" & .Range("d" & Rows.Count).End(xlUp).Row)
End With
For i = 2 To UBound(vDB, 1) Step 4
For j = 4 To UBound(vDB, 2)
n = n + 1
ReDim Preserve vR(1 To 7, 1 To n)
vR(1, n) = vDB(i, 1)
vR(2, n) = vDB(i, 2)
vR(3, n) = vDB(i, j)
vR(4, n) = vDB(i + 1, j)
vR(5, n) = vDB(i + 2, j)
vR(6, n) = vDB(i + 3, j)
vR(7, n) = vDB(1, j)
Next j
Next i
Sheets.Add
Range("a1").Resize(1, 7) = Array("Managed", "Type", "On/Off Hire", "Customer", "Locaton", "Daily Opex", "Date")
Range("a2").Resize(n, 7) = WorksheetFunction.Transpose(vR)
End Sub
包含支持的案例
Sub test()
Dim vDB, vR()
Dim Ws As Worksheet
Dim r As Long, c As Long
Dim i As Long, n As Long, j As Integer
Set Ws = ActiveSheet
With Ws
r = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
c = .Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
'vDB = .Range("a1", .Cells(r, c))
vDB = .Range("b1", "j" & .Range("d" & Rows.Count).End(xlUp).Row)
End With
For i = 2 To UBound(vDB, 1) Step 5
For j = 4 To UBound(vDB, 2)
n = n + 1
ReDim Preserve vR(1 To 8, 1 To n)
vR(1, n) = vDB(i, 1)
vR(2, n) = vDB(i, 2)
vR(3, n) = vDB(i, j)
vR(4, n) = vDB(i + 1, j)
vR(5, n) = vDB(i + 2, j)
vR(6, n) = vDB(i + 3, j)
vR(7, n) = vDB(i + 4, j)
vR(8, n) = vDB(1, j)
Next j
Next i
Sheets.Add
Range("a1").Resize(1, 8) = Array("Managed", "Type", "On/Off Hire", "Customer", "Locaton", "Support", "Daily Opex", "Date")
Range("a2").Resize(n, 8) = WorksheetFunction.Transpose(vR)
End Sub