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

恐れ入りますが、エクセルマクロの作成をお願いいたします。

AB
1?◎
2!●
3*〇


といった表があるとして、
A1?A3まで選択された状態にするとします。

ここからマクロをスタートすると、
何行入れますか?
何列目のコピーをしますか?

とインプットBOXで連続で聞いてくるようにします。

下記具体例ですが、

仮に、
何行入れますか?→2(※1)
何列目のコピーをしますか?→2(※2)

と入力されたとすると、

各行の間に2行(※1で入力された数値)ずつ行が挿入され、
A列から1列目(※2で入力された数値)の数値が挿入された行の中の一番上にコピーされるようにする

にはどうしたらよいでしょうか?

上記の例でしたら、
結果は

AB
1?◎
2◎
3
4!●
5●
6
7*〇
8〇

となります。
スタート時縦にドラッグされていない状態など、指定以外の
動きのときは「誤っています!」等が出るのみで結構です。

お手数をおかけいたしますが、よろしくお願いいたします。


●質問者: naranara19
●カテゴリ:コンピュータ
✍キーワード:A3 BOX インプット エクセル コピー
○ 状態 :終了
└ 回答数 : 2/2件

▽最新の回答へ

1 ● Mook
●35ポイント

とりあえず作ってみました。

こんな感じで、ご希望通りですか?


Sub naranara19()
 If Intersect(Columns("A:A"), Selection) Is Nothing Then
 MsgBox "A列が選択されていません。"
 Exit Sub
 End If

 Dim rg As Range
 Set rg = Intersect(Columns("A:A"), Selection)
 If rg.Count = 1 Then
 MsgBox "A列が複数選択されていません。"
 Exit Sub
 End If
 
 Dim ir As Long
 ir = Application.InputBox("何行入れますか?", Type:=1)
 
 Dim cl As Long
 cl = Application.InputBox("何列目のコピーをしますか?", Type:=1)
 
 If cl <= 0 Or ir <= 0 Then
 MsgBox "誤っています。!"
 Exit Sub
 End If
 
 Dim r As Long
 For r = rg.Row + rg.Count To rg.Row + 1 Step -1
 Rows(r & ":" & r + ir - 1).Insert
 Cells(r, "A").Value = Cells(r - 1, cl).Value
 Next
End Sub
◎質問者からの返答

ありがとうございます!!

完璧に動きました!!!

すばやい回答に感謝いたします!!!!


2 ● SALINGER
●35ポイント ベストアンサー

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

A列以外でもできるようにしておきました。

Sub Macro()
 Dim gyou As Long  '行
 Dim retu As Long  '列
 Dim StartRow As Long  '開始行
 Dim LastRow As Long  '最終行
 Dim selectRetu  '選択列
 Dim i As Long
 Dim j As Long
 
  '1列だけ選択されているか
 If Selection.Columns.Count > 1 Then
 MsgBox "誤っています!"
 Exit Sub
 End If
 
  'インプットボックス処理
 gyou = Application.InputBox(Prompt:="何行入れますか?", Type:=1)
 If gyou = 0 Then Exit Sub
 
 retu = Application.InputBox(Prompt:="何列目のコピーをしますか?", Type:=1)
 If retu = 0 Then Exit Sub
 
 StartRow = Selection.Row
 LastRow = Selection.Row + Selection.Rows.Count - 1
 selectRetu = Selection.Column
 
  '最終行から処理
 For i = LastRow To StartRow Step -1
 For j = 1 To gyou
 Rows(i + 1).Insert shift:=xlDown
 Next j
 Cells(i + 1, 1).Value = Cells(i, selectRetu + retu - 1).Value
 Next i
End Sub
◎質問者からの返答

いつもご回答ありがとうございます!!!

A列以外というのがとても嬉しいです。

ほんと、助かっています。これからもよろしくお願いいたします。

関連質問


●質問をもっと探す●



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