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

ベストアンサー

id:Mook No.1

Mook回答回数1312ベストアンサー獲得回数3912008/12/28 00:14:16

ポイント100pt

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


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

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

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以降にコピーでも同じ結果になります。

id:holysheng

ご回答ありがとうございます。

完璧です。

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

本当にやりたいのは別シートですが、今回はコピペで対応します。

早速のご回答ありがとうございました。

2008/12/28 00:22:12
  • id:Mook
    ポイントといるか賞ありがとうございます。

    下記のようにすれば、別シートを選択しても実行できます。
    ご参考までに。
    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

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

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

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

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません