各位大神帮帮忙

冷酷的云

VBA行转换列 .zip (9.34 KB, 下载次数: 10)

2018-7-25 14:27 上传

点击文件名下载附件

条件在附件里，谢谢啦！

苏小亓

1. =INDEX($B$2:$I$5,INT((ROW(A1)-1)/8)+1,MOD(ROW(A1)-1,8)+1)

复制代码

曹银强

Sub TT()
n = Range("b65536").End(xlUp).Row
arr = Range("A2:G" & n)
n = 7
For i = 1 To UBound(arr)
  For j = 1 To UBound(arr, 2)
  n = n + 1
  Cells(n, 6) = arr(i, j)
  Next
Next
End Sub

冷酷的云

不行啊！大神麻烦你再看下我的要求吧！

冷酷的云

曹银强 发表于 2018-7-25 15:10
Sub TT()
n = Range("b65536").End(xlUp).Row
arr = Range("A2:G" & n)

已经解决，谢谢!

jy03342543

Option Explicit
Sub test()
Dim Arr
Dim I, A As Integer
Arr = Worksheets("sheet1").Range("B2:G5")
A = 1
  For I = 1 To UBound(Arr)
   Worksheets("sheet2").Cells(A, 6) = Arr(I, 1)
   Worksheets("sheet2").Cells(A + 1, 6) = Arr(I, 2)
   Worksheets("sheet2").Cells(A + 2, 6) = Arr(I, 3)
   Worksheets("sheet2").Cells(A + 3, 6) = Arr(I, 4)
   Worksheets("sheet2").Cells(A + 4, 6) = Arr(I, 5)
   Worksheets("sheet2").Cells(A + 5, 6) = Arr(I, 6)
   A = A + 7
  Next
End Sub