[[20210907090343]]　『行コピー挿入』（あやぽむ）　ページの最後に飛ぶ

『行コピー挿入』（あやぽむ）

どなたかご教示よろしくお願いいたします。
VBAを勉強中なのですが、条件の入れ方がわからず苦戦中です。

文字で説明するのが難しいので、説明不足になってしまったらすみません(._.)
シート内のボタンを押すと黒丸●がある行の上をコピーし(下記表だと[3]行目)、
コピーした行を黒丸●がある上の行に挿入し、
挿入した行の内容だけを削除ということをしたいのですが難しいのでしょうか・・・
またボタンクリックごとに黒丸●の上の行をコピーし、コピーした行を黒丸●上の行に挿入・・・と繰り返したく・・

エクセルの表は下記のようになっています。
もっと横に長いのですが簡略しています・・
枠線や点線がたくさん使用されていて簡単に行コピーして挿入できないかと思い色々調べたのですが、どうも難しく。。質問させていただきました_(._.)_

    |A]|[B]   |[C] |    [D]        |   [E] |													
 [1]|  | 分類 |    |               |       |

 [2]|  | ポリ | 30 |(関数 (=D4*C3) | No.1  |

 [3]|  | 綿   | 30 |(関数 (=D4*C)  | No.25 |

 [4]|  | 商品 | A1 | 20            | 　●  |

 [5]|  |      |    |               |       |

 [6]|  | 分類 |    |               |       |

 [7]|  | レー | 40 |(関数(=D9 *C8) | No.24 |

 [8]|  | 釦A  |  6 |(関数(=D9 *C9) | No.33 |

 [9]|  | 商品 | B1 | 40            | 　◎  |

ぶしつけな質問で申し訳ないのですがどうかよろしくお願いいたします_(._.)_

＜使用 Excel：Office365、使用 OS：Windows10 ＞

ども＾＾

1）E列の下からセルの値を繰り返し見ていく
2）セルの値が●ならば、その行の下に行コピー＆行挿入
3）そのセルの値をクリア
4）1へ戻る

ということをVBA書いてやればよいのでは？

行の挿入（削除）は下からやるとよいです。
（まっつわん） 2021/09/07(火) 10:08

まっつわん様返信ありがとうございます。

●がある上の行にコピーし挿入をしたいのですがうまくいきません・・

またどこに条件を入れ込むのかわからないので
コードを教えていただけるととても助かります。

Sub maru()

    Dim maru As Long
    Dim maru2 As Range

    With ActiveSheet
        For maru = 1 To .Cells(.Rows.Count, "E").End(xlUp).Row
        If .Cells(maru, "E").Value Like "●" Then
        If maru2 Is Nothing Then
        Set maru2 = .Cells(maru, "E")
    Else

    Set maru2 = Union(maru2, .Cells(maru, "E"))
        End If
        End If
        Next maru

        If Not maru2 Is Nothing Then Intersect(maru2.EntireRow, .・・・・
        ---------------------------------------------------------------------------        
End With

End Sub

1）E列の下からセルの値を繰り返し見ていく　の部分わわかるのですがこっから先がわからないです。

どうかよろしくお願いいたします。

（あやぽむ） 2021/09/07(火) 15:51

Sub test()

    Dim SearchRange As Range
    Dim ix As Long

    '検索範囲の特定
    With ActiveSheet.UsedRange
        Set SearchRange = Intersect(.Cells, .Offset(1), .Columns(4))
    End With

    '取得されたセル範囲の確認
    MsgBox SearchRange.Address              '※動作確認用。本番では消す。

    For ix = SearchRange.Count To 2 Step -1 '下から上へ繰り返す
        With SearchRange(ix)
            If .Value = "●" Then
                .EntireRow.Copy
                .EntireRow.Offset(1).Insert '1行下にコピー挿入
                .ClearContents
            End If
        End With
    Next
End Sub

場当たり的に、傾向と対策でテクニックだけを暗記するのではなく、
１行１行、１単語１単語の理解と、
論理的解法（≒作業手順）を十分に理解されることを期待します。
分からないとことは聞いてください。

※行をコピーしたら、上に挿入しても下に挿入しても、結果は同じです。
その時に下に挿入した方が、考え方が簡単になります。
上に挿入すると、今見ているセルの行が変わるので、
番号の操作がややこしくなります。
処理済みの行は無視できるようにするために下から処理します。

（まっつわん） 2021/09/08(水) 08:22

訂正

 >For ix = SearchRange.Count To 2 Step -1 '下から上へ繰り返す

For ix = SearchRange.Count To 1 Step -1 '下から上へ繰り返す
（まっつわん） 2021/09/08(水) 09:01

まっつわん様

おはようございます！
場当たり的なのでなんとなくでやっていたので・・とてもぐさりと来ました・・
VBAやり始めて二ヶ月くらいなので・・どう構成していいかすぐわからなくなります。。
入れ込み方がまだ少ししか理解できていないですが
またわかるまでもっとしっかり１行１行、１単語１単語を調べようと思います(;_;)

●の位置を変えてSearchRange(ix).Offset(1).EntireRow.ClearContents
にしたらやりたかったことができました・・！

Sub test()

    Dim SearchRange As Range
    Dim ix As Long

    '検索範囲の特定
    With ActiveSheet.UsedRange
        Set SearchRange = Intersect(.Cells, .Offset(1), .Columns(5))
    End With

    '取得されたセル範囲の確認
    MsgBox SearchRange.Address              '※動作確認用。本番では消す。

    For ix = SearchRange.Count To 1 Step -1 '下から上へ繰り返す
        With SearchRange(ix)
            If .Value = "●" Then
                .EntireRow.Copy
                .EntireRow.Offset(1).Insert '1行下にコピー挿入
                SearchRange(ix).Offset(1).EntireRow.ClearContents
            End If
        End With
    Next
End Sub

もう少し条件を入れたいのですが自力で頑張ります。もっと精進したいと思います！
この度は本当にありがとうございます、とても助かりました・・！

（あやぽむ） 2021/09/08(水) 09:52

コメント返信：

[ 一覧(最新更新順) ]

[[20210907090343]] 『行コピー挿入』（あやぽむ） ページの最後に飛ぶ

[[20210907090343]]　『行コピー挿入』（あやぽむ）　ページの最後に飛ぶ