Excel VBA 質問スレッド No.819 (解決済)

A列にチェックが入っている行をコピーして、A5の列へ挿入

投稿者 : ワケワカメ     投稿日時 : 2022/06/22(Wed) 10:28:07     OS : Windows 10     EXCEL : Excel 2013
こんにちは。
少し困っておりまして、どなたか知識を貸していただけませんでしょうか。

A列からN列までデータが入っております。
A列にチェックが入っている行(A列からN列まで)をコピーして、同シートのA5(ここは固定)に行挿入して転記したいです。面倒なことに、チェックが入っている行は連続しておらず、飛び飛びです。

例えば、この行と、この行と、この行の計3行を、A5から下へ3行挿入して転記したいです。


VBAのサイトを見て、自分なりに変えてみて、コピーした行を別シート(Sheet1からSheet2)へ挿入と転記、ならできました。ですが、同一シート名(Sheet1とSheet1)にすると、行数挿入は正しくできますが、転記内容が一番上のチェックが入った行の内容が同一で転記されるだけです。別シートならうまくいくのに、なぜだろう、と止まってしましました。

どなたか分かる方は、ご教示いただけませんでしょうか。
宜しくお願い致します。



Sub チェックが付いた行をコピーして行挿入して転記()

Dim Sht1 As Worksheet
Dim Sht2 As Worksheet
Dim LastRow As Long
Dim i As Long
Dim J As Long
Dim SearchWord As String

Set Sht1 = Sheets("Sheet1")
Set Sht2 = Sheets("Sheet2")

'検索キーワード環境依存文字のチェックマーク
SearchWord = ChrW(&H2713)

Sht1.Select
J = 5

'最終行取得
LastRow = Sht1.Cells(Rows.Count, 1).End(xlUp).Row

For i = 5 To LastRow

'特定キーワードを含む場合
If InStr(Cells(i, 1), SearchWord) > 0 Then

'該当データをコピー
Sht1.Range(Cells(i, 1), Cells(i, 16)).Copy
'該当データを行挿入して転記
Sht2.Cells(J, 1).Insert Shift:=xlDown
J = J + 1
'選択解除
Application.CutCopyMode = False
End If
Next i
End Sub

[返信 1] Re : A列にチェックが入っている行をコピーして、A5の列へ挿入
投稿者 : ワケワカメ     投稿日時 : 2022/06/22(Wed) 10:29:53
ごめんなさい。
タイトルが間違っておりました。

A列にチェックが入っている行をコピーして、A5位置へ挿入

でした。
わかりにくくなってすみません。

[返信 2] Re : A列にチェックが入っている行をコピーして、A5の列へ挿入
投稿者 : てらてら     投稿日時 : 2022/06/22(Wed) 11:28:49
こんにちは。

行の削除とか、挿入の時は通常のループが使えません。
検索すべき行が増えていくのですから、ヒットした行をまた検索してしまうのです。
Sheet2なら大丈夫なのは、ただ書き込んでいるだけだからです。

ちなみに行の削除は、逆ループさせないとダメなのは定番の考え方です。

Whileを使うのと、i = i + 1を2つ配置するのがミソです。
参考にしてください。


Sub チェックが付いた行をコピーして行挿入して転記()

Dim Sht1 As Worksheet
Dim Sht2 As Worksheet
Dim LastRow As Long
Dim i As Long
Dim J As Long
Dim SearchWord As String

Set Sht1 = Sheets("Sheet1")
'Set Sht2 = Sheets("Sheet2")

'検索キーワード環境依存文字のチェックマーク
SearchWord = ChrW(&H2713)

Sht1.Select
J = 5

'最終行取得
LastRow = Sht1.Cells(Rows.Count, 1).End(xlUp).Row
i = 5
Do While Cells(i, 1) <> ""
'特定キーワードを含む場合
If InStr(Cells(i, 1), SearchWord) > 0 Then

'該当データをコピー
Sht1.Range(Cells(i, 1), Cells(i, 16)).Copy
'該当データを行挿入して転記
'Sht2.Cells(J, 1).Insert Shift:=xlDown
Sht1.Cells(J, 1).Insert Shift:=xlDown
J = J + 1
i = i + 1
'選択解除
Application.CutCopyMode = False

End If

i = i + 1
If i > 30 Then Exit Sub ’無限ループ回避のおまじない。
Loop
MsgBox i


End Sub

[返信 3] Re : A列にチェックが入っている行をコピーして、A5の列へ挿入
投稿者 : 収録     投稿日時 : 2022/06/22(Wed) 11:50:46
チェックが入っているというのがどんなものか解りませんが、
オートフィルタ使えば良いと思っています。
こっちの方が楽だし、手動だけでも済みそうだし。

[返信 4] Re : A列にチェックが入っている行をコピーして、A5の列へ挿入
投稿者 : ワケワカメ     投稿日時 : 2022/06/22(Wed) 12:58:06
てらてら様

お忙しい中お知恵を貸して頂きありがとうございますm(__)m
ご教示いただいた記述で、Sheet1とSheet2を分けずに、同じシートにした場合、
うまく挙動せず、
メッセージボックスで

5

と表示されていまいました。
MsgBox i
の兼ね合いでしょうか??

やはり、同一ページにコピーした行を挿入して転記は難しいでしょうかm(__)m

[返信 5] Re : A列にチェックが入っている行をコピーして、A5の列へ挿入
投稿者 : ワケワカメ     投稿日時 : 2022/06/22(Wed) 12:58:23
てらてら様

お忙しい中お知恵を貸して頂きありがとうございますm(__)m
ご教示いただいた記述で、Sheet1とSheet2を分けずに、同じシートにした場合、
うまく挙動せず、
メッセージボックスで

5

と表示されていまいました。
MsgBox i
の兼ね合いでしょうか??

やはり、同一ページにコピーした行を挿入して転記は難しいでしょうかm(__)m

[返信 6] Re : A列にチェックが入っている行をコピーして、A5の列へ挿入
投稿者 : ワケワカメ     投稿日時 : 2022/06/22(Wed) 13:10:25
収録様


案を頂きありがとうございます。

チェックが入っているものをオートフィルタして抽出された行をコピーしても良いのですが、
エクセルの特性上、飛び飛びの行のコピーは、右クリックで一発貼付ができなくて困っておりました。
現在は、一行一行コピーして貼付しております。

全体用途としては、
過去の発注部品一覧があり、チェックをした行のみ抽出して、注文書を印刷できる。
という機能です。
チェックをした行のみ印刷するというのは、VBAですでに動いており、完了済です。

お困りごととしては、
その過去の発注部品データをコピーして、発注日のみ変えて新規で発注書を印刷したい時に困っております。
が、毎回同じ部品が要るとも限らず(過去の製品の修繕などで一部の部品のみ必要の時など)
行が飛び飛びになってコピーしたいので、手動で1行1行コピペしているのを、自動でできたらいいなと思っておりました。

[返信 7] Re : A列にチェックが入っている行をコピーして、A5の列へ挿入
投稿者 : てらてら     投稿日時 : 2022/06/22(Wed) 14:36:29
こちらでは上手くいってますが、、、

Sheet2を開きながらやると失敗します。
一応、シート指定したものを書いておきます。
最後のメッセージボックスは消し忘れです。

Sub チェックが付いた行をコピーして行挿入して転記()

Dim Sht1 As Worksheet
Dim Sht2 As Worksheet
Dim LastRow As Long
Dim i As Long
Dim J As Long
Dim SearchWord As String

Set Sht1 = Sheets("Sheet1")
'Set Sht2 = Sheets("Sheet2")

'検索キーワード環境依存文字のチェックマーク
SearchWord = ChrW(&H2713)

Sht1.Select
J = 5

'最終行取得
LastRow = Sht1.Cells(Rows.Count, 1).End(xlUp).Row
i = 5
Do While Sht1.Cells(i, 1) <> ""
'特定キーワードを含む場合
If InStr(Sht1.Cells(i, 1), SearchWord) > 0 Then

'該当データをコピー
Sht1.Range(Cells(i, 1), Cells(i, 16)).Copy
'該当データを行挿入して転記
'Sht2.Cells(J, 1).Insert Shift:=xlDown
Sht1.Cells(J, 1).Insert Shift:=xlDown
J = J + 1
i = i + 1
'選択解除
Application.CutCopyMode = False

End If

i = i + 1
If i > 30 Then Exit Sub
Loop
'MsgBox i


End Sub

[返信 8] Re : A列にチェックが入っている行をコピーして、A5の列へ挿入
投稿者 : ワケワカメ     投稿日時 : 2022/06/22(Wed) 16:08:37
てらてら様

他のVBAは動くのですが、
ご指南頂いた内容をコピペしてもなぜかうんともすんとも言わず、
せっかく教えていただいたので私の方で色々試してみたいと思います。

もう少しお時間ください。
宜しくお願い致します。


■[返信 7] てらてらさん(2022-06-22 14:36:29)の記事
> こちらでは上手くいってますが、、、

> Sheet2を開きながらやると失敗します。
> 一応、シート指定したものを書いておきます。
> 最後のメッセージボックスは消し忘れです。

> Sub チェックが付いた行をコピーして行挿入して転記()

> Dim Sht1 As Worksheet
> Dim Sht2 As Worksheet
> Dim LastRow As Long
> Dim i As Long
> Dim J As Long
> Dim SearchWord As String

> Set Sht1 = Sheets("Sheet1")
'Set Sht2 = Sheets("Sheet2")

'検索キーワード環境依存文字のチェックマーク
> SearchWord = ChrW(&H2713)

> Sht1.Select
> J = 5

'最終行取得
> LastRow = Sht1.Cells(Rows.Count, 1).End(xlUp).Row
> i = 5
> Do While Sht1.Cells(i, 1) <> ""
'特定キーワードを含む場合
> If InStr(Sht1.Cells(i, 1), SearchWord) > 0 Then

'該当データをコピー
> Sht1.Range(Cells(i, 1), Cells(i, 16)).Copy
'該当データを行挿入して転記
'Sht2.Cells(J, 1).Insert Shift:=xlDown
> Sht1.Cells(J, 1).Insert Shift:=xlDown
> J = J + 1
> i = i + 1
'選択解除
> Application.CutCopyMode = False

> End If

> i = i + 1
> If i > 30 Then Exit Sub
> Loop
'MsgBox i


> End Sub

[返信 9] Re : A列にチェックが入っている行をコピーして、A5の列へ挿入
投稿者 : ピロリ     投稿日時 : 2022/06/22(Wed) 16:24:59
■[返信 4] ワケワカメさん(2022-06-22 12:58:06)の記事
> メッセージボックスで
> 5
> と表示されていまいました。
ということは、いきなり Sht1.Cells(5, 1) = ""(空白)でループを抜けているということですね。
A列には空白も混在しているって前提で、てらてらさんもコードも使用させていただきつつ、下記を試してみて下さい。
変更箇所は、★印のコードです。

Sub チェックが付いた行をコピーして行挿入して転記()

Dim Sht1 As Worksheet
Dim Sht2 As Worksheet
Dim LastRow As Long
Dim i As Long
Dim J As Long
Dim SearchWord As String
Dim k As Long '★ループカウンタ:k を追加しました。

Set Sht1 = Sheets("Sheet1")
'Set Sht2 = Sheets("Sheet2")

'検索キーワード環境依存文字のチェックマーク
SearchWord = ChrW(&H2713)

Sht1.Select
J = 5

'最終行取得
LastRow = Sht1.Cells(Rows.Count, 1).End(xlUp).Row
i = 5
'Do While Sht1.Cells(i, 1) <> "" '★A列には空白も混在する前提で Do Whileではなく、
For k = 5 To LastRow '★Forループに変更してみます。
'特定キーワードを含む場合
If InStr(Sht1.Cells(i, 1), SearchWord) > 0 Then

'該当データをコピー
Sht1.Range(Cells(i, 1), Cells(i, 16)).Copy
'該当データを行挿入して転記
'Sht2.Cells(J, 1).Insert Shift:=xlDown
Sht1.Cells(J, 1).Insert Shift:=xlDown
J = J + 1
i = i + 1
'選択解除
Application.CutCopyMode = False

End If

i = i + 1
'If i > 30 Then Exit Sub '★これは削除とします。
'Loop '★Do ~ Loopではなく、
Next k '★For ~ Next への変更です。

'MsgBox i

End Sub

[返信 10] Re : A列にチェックが入っている行をコピーして、A5の列へ挿入
投稿者 : ワケワカメ     投稿日時 : 2022/06/22(Wed) 17:00:05
てらてら様
ピロリ様

できました!!!(TT)
あまりに手詰まりしていたので、できた瞬間の感動がすごくて、
本当に感謝しております。
お忙しい中、コードを一生懸命考えてくださり、ありがとうございましたm(__)m

当掲示板について
返信入力フォーム
お 名 前  :
内  容   :
ステータス  : この質問を解決済みにする

認証コード  :
        キャプチャ画像


( 処理日時 : 2022-07-07 14:13:52 )

Page
Top