以第二步的方式转置数据？

Question

我有这样的代码，它基于数据集范围Data创建一个总体数组。

我希望让它转置行块(总是每两行Step -2)，并将下一个块放置为上次转置的offset(1)。

例如：Rows 2-3在E1:D134中，rows 4-5在E135:D169中，等等。

这段代码过去所做的是将单个数组打印到工作表中并将其保存下来，但我正在截断它，让它从E1开始打印前两行转置行(仅为两列)，然后下面的两行将被偏移到E:D列下的下一个可用位置。

Option Explicit
Sub Main()
  Dim wb As Workbook
  Dim Data, Last, Mgr
  Dim i As Long, j As Long, k As Long, a As Long
  Dim Dest As Range
  Set wb = ThisWorkbook
  Set Dest = wb.Sheets("Sheet2").Range("E1")
  With ThisWorkbook.Sheets("Sheet3")
    Data = .Range("ed2", .Range("A" & Rows.Count).End(xlUp))
  End With
  wb.Activate
  Application.ScreenUpdating = False
  For i = 1 To UBound(Data)
    If Data(i, 1) <> Last Then
      If i > 1 Then
        Dest.Select
    End If
      Last = Data(i, 1)
      j = 0
    End If
    a = 0
    For k = 1 To UBound(Data, 2)
      Dest.Offset(a, j) = Data(i, k)
      a = a + 1
    Next
    j = j + 1
  Next
End Sub

我将如何根据上述代码指定这一点？

Answer 1

要实现这一点，有多种方法。这可能是我最接近你的方法(如果我正确理解你想要达到的目标)，可以试试

Sub Main()
  Dim wb As Workbook
  Dim Data, Last, Mgr
  Dim Rw As Long, Col As Long
  Dim i As Long, k As Long, j As Long
  Dim Dest As Range, TmpArr As Variant
  Set wb = ThisWorkbook
  Set Dest = wb.Sheets("Sheet2").Range("E1")
  With ThisWorkbook.Sheets("Sheet3")
    Data = .Range("ed2", .Range("A" & Rows.Count).End(xlUp))
  End With


Rw = -1
For i = LBound(Data, 1) To UBound(Data, 1) Step 2
k = 1
If i = UBound(Data) Then k = 0
    For Col = LBound(Data, 2) To UBound(Data, 2)
    Rw = Rw + 1
        For j = 0 To k
        Dest.Offset(Rw, j).Value = Data(i + j, Col)
        Next j
    Next Col
Next i

End Sub