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

エクセルのマクロ,VBAについての質問です。ベスト回答者には500pt以上贈呈します。画像のようなエクセルシートなんですが、例えばセルA4が1と記載されてる場合は、5行目全体を選択して、1行挿入したいのです。同じく、セルA8では4と記載されているので、次の行である9行目全体を選択して、4行を挿入したいのです。
なお、A列が0の場合は挿入は不要という意味です。

エクセルのマクロ、VBAに詳しい人、よろしくお願いいたします。

1163151706
●拡大する

●質問者: shinken
●カテゴリ:コンピュータ ウェブ制作
✍キーワード:VBA エクセル セル ベスト マクロ
○ 状態 :終了
└ 回答数 : 4/4件

▽最新の回答へ

1 ● nankichi
●50ポイント

こんな感じでしょうか。


Sub Macro1()

ThisWorkbook.Activate

i = 1

Do While Cells(i, 1) <> ""

Cells(i, 1).Select

j = Val(Cells(i, 1).Value)

If j > 0 Then

For k = 1 To j

' Rows(i).Copy

Rows(i + 1).Insert Shift:=xlDown

Next

End If

i = i + j + 1

Loop

Cells(i, 1).Select

End Sub

5行目全体を選択して、1行挿入したいのです。

この挿入は空行を挿入する、と理解しました。

もし挿入の意味が行のコピーなら、赤字部分のコメントをはずしてください。


2 ● y3kz
●500ポイント ベストアンサー

以下のマクロでどうでしょうか。

Sub my_insert()
 Dim oCurrentRow As Range '数値を読み取る行
 Dim oNextRow As Range '次の行(この行の上に数値分の行を挿入)
 Dim lInsertRows As Long '挿入する行数
 Dim i As Long 'ループ変数
 
 '初期値の設定
 Set oCurrentRow = Rows(1)
 Set oNextRow = Rows(2)
 
 'A列の値がなくなるまでループ
 Do Until oCurrentRow.Cells(1.1).Value = ""
 '挿入する行数を読み取る。
 lInsertRows = oCurrentRow.Cells(1, 1).Value
 
 '挿入がある場合、行数分だけ挿入を繰り返す。
 If lInsertRows > 0 Then
 For i = 1 To lInsertRows
 oNextRow.Insert Shift:=xlDown
 Next
 End If
 
 '処理する行を設定しなおす。
 Set oCurrentRow = oNextRow
 Set oNextRow = oCurrentRow.Offset(1, 0)
 Loop
End Sub

http://q.hatena.ne.jp/

◎質問者からの返答

ありがとうございました。ベスト回答です。


3 ● きゃづみぃ
●100ポイント

Sub Macro1()

'

' Macro1 Macro

'

' Keyboard Shortcut: Ctrl+q

'

For a = 65536 To 1 Step -1

If Range("A" & a) <> "" And Range("A" & a) <> 0 Then

Rows(a & ":" & a).Copy

b = Range("A" & a)

Rows(a + 1 & ":" & a + b).Select

Selection.Insert Shift:=xlDown

End If

Next a

End Sub


行の最終からチェックしていますので、始まるまで少し時間がかかります。

あと 数字の次の行に数分挿入しているので 3だったら

4行になります。

あと 0の場合は、何もなりません。


4 ● Mook
●50ポイント

シートのタブを右クリックし、コードの表示をして、コードを貼り付けて下しさい。

Private Sub Worksheet_Change(ByVal Target As Range)
' --- 入力されたのが A列かの判定
 If Intersect(Target, Range("A2:A65535")) Is Nothing Then
 Exit Sub
 End If
 
' --- 入力されたのが 数値かの判定
 If IsNumeric(Target.Value) = False Then
 Exit Sub
 End If
 
' --- 入力されたのが 10 以上であれば、一応入力の確認
 If Target.Value > 10 Then
 If vbNo = MsgBox(Target.Value &amp; "行挿入しますか?", vbYesNo, "挿入確認") Then
 Exit Sub
 End If
 End If
 
 Application.EnableEvents = False
 Rows(Target.Row + 1 &amp; ":" &amp; Target.Row + Target.Value).Select
 Selection.Insert
 Target.Select
' --- 入力された数値は [元の数値] の形に変更:意図しない挿入への対策
 Target.Value = "[" &amp; Target.Value &amp; "]"
 Application.EnableEvents = True
End Sub

仕様を若干変更しましたが、[] を付けたくない場合は最後から2行目を削除してください。

◎質問者からの返答

みなさま、回答ありがとうございました。お約束通り、ベスト回答者には500ptです。他の回答者様にも有益だった場合は回答しております。

関連質問


●質問をもっと探す●



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