-1

VB を使用して、大きなデータを Excel で表示しています。それらは A1:A3000 に表示されます。このコードを使用して、A1:A6 を B1:G1 に転置しています。

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

動作していますが、このプロセスを A3000 まで繰り返すのに問題があります。基本的に、1 列 x 3000 行のデータを 6 列 x 500 行のデータに変換したい。つまり、最終結果には 500 行と列 B:G が必要です。

4

2 に答える 2

0

コードは 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
于 2013-07-27T18:39:58.523 に答える