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

なお、A列が0の場合は挿入は不要という意味です。

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

回答の条件
  • 1人2回まで
  • 登録:2006/11/10 18:41:49
  • 終了:2006/11/10 22:01:28

ベストアンサー

id:y3kz No.2

y3kz回答回数31ベストアンサー獲得回数92006/11/10 19:42:18

ポイント500pt

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

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/

id:shinken

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

2006/11/10 21:57:06

その他の回答(3件)

id:nankichi No.1

nankichi回答回数562ベストアンサー獲得回数22006/11/10 19:31:15

ポイント50pt

こんな感じでしょうか。


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行挿入したいのです。

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

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

id:y3kz No.2

y3kz回答回数31ベストアンサー獲得回数92006/11/10 19:42:18ここでベストアンサー

ポイント500pt

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

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/

id:shinken

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

2006/11/10 21:57:06
id:taknt No.3

きゃづみぃ回答回数13539ベストアンサー獲得回数11982006/11/10 20:18:03

ポイント100pt

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の場合は、何もなりません。

id:Mook No.4

Mook回答回数1312ベストアンサー獲得回数3912006/11/10 20:36:43

ポイント50pt

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

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行目を削除してください。

id:shinken

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

2006/11/10 21:59:10
  • id:Mook
    他の方の回答を見て気が付きました。

    仕様を誤解していました。
    逐次処理ではなくて一括処理だったのですね。

    失礼しました。
  • id:shinken
    回答ありがとうございました。私の質問が悪かったです。お気になさらないでください。
  • id:Mook
    まったくの勘違いに、ポイントをすみません。

    もし動作を試されるときは、 「&amp;」 を 「&」 に書き換えて
    お試しください。

    蛇足ながら、一応訂正まで(勝手に変換されるようです)。
  • id:y3kz
    いるかまでいただき、ありがとうございます。
    とても嬉しいです!

    ただ、タイプミスがありました…。
    12行目。

    >Do Until oCurrentRow.Cells(1.1).Value = ""

    (1.1)は、(1,1)の間違いです。
    一応動作したんで、気がつかなかったです…。
  • id:nankichi
    ん?ベストの回答、動きますか?
    A列に数値以外の文字列などが入っていると、
    lInsertRows > 0
    で引っかかるはずですが。
  • id:y3kz
    ほんとだ。
    せめて、

    >'初期値の設定
    >Set oCurrentRow = Rows(2)
    >Set oNextRow = Rows(3)

    じゃないと、例示のシートですら動作しないですね…。
    (自分がテストしたシートでは、項目名の行、省略してました…。)
    雑ですみません…。

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

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

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

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