人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

<エクセルマクロ:積み下げマクロ>
A1?Anセル(nは変数)にある文字列(数値列混在)群を横n列y列を同時に(nは変数)
A(n+1)セル以下にX個セットでコピーして貼り付けるマクロを希望します。

X、yはメッセージボックス等で
「○○○(=X =y)セット貼りつける」等のメッセージで○○○に好きな数字を入れると
その数だけ下にセットで貼りつけられるマクロです。

???マクロ実行前(n=3、X=3 y=3を例として)????
1 1 1 1
2 2 2 2
3 3 3 3
これでマクロ実行 で x○○○=3 y○○○=3と入力すると

???マクロ実行後????
1 1 1 1 →方向にも複数列n
2 2 2 2
3 3 3 3
1 1 1 1
2 2 2 2
3 3 3 3
1 1 1 1
2 2 2 2
3 3 3 3
1 1 1 1
2 2 2 2
3 3 3 3


*最初の3列1セット+3セットで、計4セットA1から下に並びさらに横に複数列がA1からZ1方向にn列(nは変数)が一度にコピーできる様なマクロが希望します。





●質問者: inosisi
●カテゴリ:コンピュータ
✍キーワード:A1 エクセル コピー セル ボックス
○ 状態 :終了
└ 回答数 : 4/4件

▽最新の回答へ

1 ● SALINGER
●70ポイント

質問がちょっと意味不明な感じなので、私のほうで勝手に解釈して作ってみました。

違う場合はコメント欄をオープンしていただけると修正します。


貼りつけたい範囲を選択して下記のコードを実行すると、

横と縦に貼り付ける数を聞いてくるので入力すれば選択箇所をその数だけ縦横に貼り付けます。

Sub Macro()
 Dim x As Long
 Dim y As Long
 Dim i As Long
 Dim j As Long
 
 x = Application.InputBox("横に貼り付ける数を入力してください(X)", Type:=1)
 If x <= 0 Then Exit Sub
 y = Application.InputBox("縦に貼り付ける数を入力してください(Y)", Type:=1)
 If y <= 0 Then Exit Sub
 
 For j = 0 To y - 1
 For i = 0 To x - 1
 Selection.Copy Cells(j * Selection.Rows.Count + 1, i * Selection.Columns.Count + 1)
 Next i
 Next j
End Sub
◎質問者からの返答

ありがとうございます。

これでOKなんですがこちらの説明が不足でした。

コピーもとの範囲指定の始点が任意にできればありがたいです。

たとえばI7からAG10の範囲をコピーしてx個その下に貼り付けます。

データ参照の元がA1からH90(Hn)nは変数にありますので

それをさけるかたちでコピー貼り付けをしたいのです。

よろしくお願いします。


2 ● きゃづみぃ
●10ポイント
Sub test()
n = 4

x = InputBox("xを入れてください。")
y = InputBox("yを入れてください。")
If x = "" Or y = "" Then Exit Sub

by = Cells(1, 1).End(xlDown).Row

Range(Cells(1, 1), Cells(by, n)).Copy

For c1 = 1 To x
 For c2 = 1 To y
 Cells((c2 - 1) * by + 1, (c1 - 1) * n + 1).Select
 ActiveSheet.Paste
 Next c2
Next c1

End Sub

こんな感じでどうでしょうか?


3 ● SALINGER
●70ポイント ベストアンサー

こちらでどうでしょうか。

選択した範囲を視点にして縦横にしました。

Sub Macro()
 Dim x As Long
 Dim y As Long
 Dim i As Long
 Dim j As Long
 
 x = Application.InputBox("横に貼り付ける数を入力してください(X)", Type:=1)
 If x <= 0 Then Exit Sub
 y = Application.InputBox("縦に貼り付ける数を入力してください(Y)", Type:=1)
 If y <= 0 Then Exit Sub
 
 For j = 0 To y - 1
 For i = 0 To x - 1
 Selection.Copy Cells(Selection.Row + j * Selection.Rows.Count, _
 Selection.Column + i * Selection.Columns.Count)
 Next i
 Next j
End Sub
◎質問者からの返答

ありがとうございます。完璧です。

今後使用してまた何か疑問等でましたら質問させていただきます。

人力検索はてなを利用させていただいたのは初めてですので

勝手がわからずご迷惑お掛けしたかと思いますが今後ともご指導のほど

よろしくおねがいいたします。


4 ● きゃづみぃ
●0ポイント

開始セルと終了セルにそれぞれアドレスを入れて実行すればいいです。

Sub test()
開始セル = "I7"
終了セル = "AG10"

x = InputBox("xを入れてください。")
y = InputBox("yを入れてください。")
If x = "" Or y = "" Then Exit Sub


Range(Range(開始セル), Range(終了セル)).Copy

コピー行数 = Range(終了セル).Row - Range(開始セル).Row + 1
コピー列数 = Range(終了セル).Column - Range(開始セル).Column + 1

For c1 = 1 To y
 For c2 = 1 To x
 Cells((c1 - 1) * コピー行数 + Range(開始セル).Row, (c2 - 1) * コピー列数 + Range(開始セル).Column).Select
 ActiveSheet.Paste
 Next c2
Next c1

End Sub

◎質問者からの返答

エラーがでてうまくいかなかったです。

申し訳ございませんが今回は他の人の回答で解決しましたのであしからず。

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ