|
- Sub test2()
- Dim r%, i%
- Dim arr, brr
- With Worksheets("原始表")
- r = .Cells(.Rows.Count, 2).End(xlUp).Row
- r = Application.Ceiling(r - 1, 6) + 1
- arr = .Range("a2:g" & r)
- End With
- ReDim brr(1 To UBound(arr) / 6, 1 To 27)
- m = 0
- For i = 1 To UBound(arr) Step 6
- m = m + 1
- brr(m, 1) = arr(i, 1)
- brr(m, 2) = arr(i, 2)
- brr(m, 3) = arr(i, 3)
- For k = 1 To 6
- n = arr(i + k - 1, 7)
- brr(m, n * 4) = arr(i + k - 1, 7)
- brr(m, n * 4 + 1) = arr(i + k - 1, 4)
- brr(m, n * 4 + 2) = arr(i + k - 1, 6)
- brr(m, n * 4 + 3) = arr(i + k - 1, 5)
- Next
- Next
- With Worksheets("目标表")
- .UsedRange.Offset(1, 0).ClearContents
- .Range("a2").Resize(UBound(brr), UBound(brr, 2)) = brr
- r = 1 + UBound(brr)
- With .Range("a1:aa" & r)
- .Borders.LineStyle = xlContinuous
- With .Font
- .Size = 10
- .Name = "微软雅黑"
- End With
- End With
- With .UsedRange
- .HorizontalAlignment = xlCenter
- .VerticalAlignment = xlCenter
- End With
- End With
- End Sub
复制代码 |
|