Question

我正在使用VB在excel中显示大数据。它们出现在A1：A3000。我使用以下代码将A1：A6转置为B1：G1：

sheet.Range("A1:A6").Copy()
sheet.Range("B1").PasteSpecial(Transpose:=True)

它正在运行，但我在向A3000重复此过程时遇到了麻烦。基本上我想将1列x3000行数据转换为6列x 500行数据，即最终结果应该有500行和B列：G。

Answer 1

这对你有用吗？

Sub Test()
  Dim R1 As Long, R2 As Long, C2 As Long
  R2 = 1
  C2 = 2
  For R1 = 1 To ActiveSheet.UsedRange.Rows.Count
    Cells(R2, C2) = Cells(R1, 1)
    If C2 < 7 Then
      C2 = C2 + 1
    Else
      R2 = R2 + 1
      C2 = 2
    End If
  Next R1
End Sub

Answer 2

请注意，代码是在VBA中它不是进行复制/粘贴，而是转换范围的内容（即数组）

Option Explicit

Sub Tabulate(ByVal src As Range, ByVal splitSize As Integer, _
ByVal destRangeStart As Range)
Dim i As Integer
Dim rangeToCopy As Range
Dim rangeToPasteOver As Range

Set rangeToCopy = src
Set rangeToPasteOver = destRangeStart

Debug.Print Now
Application.ScreenUpdating = False
For i = 1 To src.Cells.Count Step splitSize
'    rangeToCopy.Resize(splitSize).Copy
'    rangeToPasteOver.PasteSpecial Transpose:=True

    rangeToPasteOver.Resize(ColumnSize:=splitSize).Value = _
        Transform2DArray(rangeToCopy.Resize(splitSize).Value)

    Set rangeToCopy = rangeToCopy.Offset(splitSize)
    Set rangeToPasteOver = rangeToPasteOver.Offset(1)
Next
Application.ScreenUpdating = True

Debug.Print Now
End Sub
Function Transform2DArray(ByVal src As Variant) As Variant
Dim returnValue As Variant

Dim rowCtr As Long
Dim colCtr As Long

Dim destColCtr As Long
Dim destRowCtr As Long


Dim lRows As Long
Dim uRows As Long

Dim lCols As Long
Dim uCols As Long

lRows = LBound(src, 1)
uRows = UBound(src, 1)

lCols = LBound(src, 2)
uCols = UBound(src, 2)

ReDim returnValue(lCols To uCols, lRows To uRows)

destRowCtr = lCols

For colCtr = lCols To uCols
    destColCtr = lRows
    For rowCtr = lRows To uRows
        returnValue(destRowCtr, destColCtr) = src(rowCtr, colCtr)
        destColCtr = destColCtr + 1
    Next
    destRowCtr = destRowCtr + 1
Next

Transform2DArray = returnValue
End Function

使用VB进行Excel转置

2 个答案: