0

列「B」のすべてを転置しようとしていますが、行をスキップして次の 4 つを取得し、同じ列に貼り付けたいと考えています。このループをすべての列 "B" で 5 行ごとにスキップし、範囲を次の開いているセルまたは "Range" に手動で個別に入力せずに自動的に変更するにはどうすればよいですか?

Range("B12:B16").Select
    Selection.Copy
    Sheets("Sheet2").Select
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Range("B18:B22").Select
    Selection.Copy
    Sheets("Sheet2").Select
    Range("A3").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Range("B24:B28").Select
    Selection.Copy
    Sheets("Sheet2").Select
    Range("A4").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
4

1 に答える 1

1

このコードを試すことができます。Excel 2010 で 10,000 個を超えるセルでテストしました。

Sub SkipOnFive()

Dim inRow As Integer 'number of row in source worksheet
Dim outRow As Integer 'number of row in output worksheet
Dim outCol As Integer 'number of column in output worksheet

Dim strTemp As String

inRow = 1 'this is your start row on input sheet
outRow = 1 ' this is your start row on output sheet

Do
    For outCol = 1 To 4
        strTemp = Cells(inRow, 2).Value
        Worksheets(2).Cells(outRow, outCol).Value = strTemp
       inRow = inRow + 1
    Next
    outRow = outRow + 1
    inRow = inRow + 1
Loop While strTemp <> vbNullString 'vbnullstring is kind of empty string, but it does not use any resources to create
End Sub
于 2010-06-02T20:40:52.827 に答える