ExcelのMacroについて質問です。

Question

holysheng

3

3もっと見る

100pt

コンピュータ

ExcelのMacroについて質問です。

以下のような、A列にx,y,z,（以下続く）と続くデータがあるとします。
x
y
z
...

上記のようなデータを、x,x,x,y,y,y,z,z,z,（以下続く）として、
どこかへ表示したいと思います。
x
x
x
y
y
y
z
z
z
...

おそらくExcelのマクロを使えばできると思うのですが、
一度も使ったことがないので、
ご教示いただければ助かります。

よろしくお願いいたします。

回答の条件

1人2回まで

登録：2008/12/27 23:53:56
終了：2008/12/28 00:22:37

※ 有料アンケート・ポイント付き質問機能は2023年2月28日に終了しました。

Mook 2008/12/28 00:31:03

ポイントといるか賞ありがとうございます。

下記のようにすれば、別シートを選択しても実行できます。
ご参考までに。
Sub copy3()
　　Dim lastRow As Long
　　lastRow = Range("A" & Rows.Count).End(xlUp).Row
　　If CLng(lastRow / 3) > Rows.Count Then
　　　　lastRow = CLng(Rows.Count / 3)
　　End If
　　
　　Dim dstRange As Range
　　Set dstRange = Application.InputBox(prompt:="開始する位置を選択してください。", Type:=8)
　　For i = 1 To lastRow
　　　　dstRange.Offset(3 * i - 3).Resize(3, 1) = Cells(i, "A").Value
　　Next
End Sub

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

リクエスト送信済

回答リクエストを送信したユーザーはいません

Mook · Accepted Answer · 2008-12-28T00:14:16+09:00

表示するのは同じシートでしょうか。

表示を開始する位置を選択した状態で下記を実行してみてください。

シートタブを右クリックして「コードの表示」で表示された右上のウィンドウに下記をコピーし、

EXCEL に戻って、データを記載したい先頭位置を選択した状態で、Alt+F8 で Copy3 を選択し

実行です。

Sub Copy3()
    Dim lastRow As Long
    lastRow = Range("A" & Rows.Count).End(xlUp).Row
    If CLng(lastRow / 3) > Rows.Count Then
        lastRow = CLng(Rows.Count / 3)
    End If
    
    Dim dstRange As Range
    
    For i = 1 To lastRow
        Selection.Offset(3 * i - 3).Resize(3, 1) = Cells(i, "A").Value
    Next
End Sub

対象を別シートにしたい等であれば、コメントで対応しますので有効にしてください。

蛇足ですが、今回の例を計算式でやるなら例えばB1に

=INDIRECT(ADDRESS((2+ROW())/3,1))

と書き、B2以降にコピーでも同じ結果になります。

ExcelのMacroについて質問です。

ベストアンサー

Mook13143932008/12/28 00:14:16

コメント（1件)

この質問への反応（ブックマークコメント）