Excel VBAでSheet1のD列に「処分」という文字が入力されていたら、その行を
Sheet2へコピーし、Sheet1のその行を削除するというマクロを作成したいのですが、
削除をさせる位置が悪いのか件数が合いません。
下の例では、Sheet1のD列には「処分」という文字が入力されている行が3行あります。
Sheet1の1,3,4行目をSheet2へコピーした後にSheet1の1,3,4行目を削除して
行を上に詰めたいのです。
ネットで検索したり、書籍を読みながらここまで作成したのですが、どうしてもうまくいきません。
大変困っております。どうか、間違えている箇所を教えてください。よろしくお願いします。
A B C D E F
-|-----------------------------------------
1| 1 03/01 時計 処分 倉庫 特になし
2| 2 03/05 電話 保留 倉庫 連絡済
3| 3 03/10 紙袋 処分 売店 使用済み
4| 4 03/11 電池 処分 倉庫 空白
5| 5 03/12 時計 保留 売店 空白
Private Sub cmdmSyobun_Click()
Dim SyobunWord As String
Dim gyou As Long
Dim word As String
Dim LastRow As Long
Dim hantei As Integer
Dim count As Integer
Dim baseB As Workbook
Dim baseS As Worksheet
SyobunWord = "処分"
Set baseB = ThisWorkbook
Set baseS = baseB.Worksheets("Sheet1")
baseS.Activate
With Worksheets("Sheet1")
hantei = MsgBox("「処分」データを移動しますか?", vbYesNo)
Select Case hantei
Case vbYes
count = 0
gyou = 2
LastRow = baseS.Cells(Rows.count, 1).End(xlUp).Row
Do While Cells(gyou, 4) <> ""
word = Cells(gyou, 4)
If InStr(word, MoveWord) >= 1 Then
count = count + 1
Rows(gyou).Copy Worksheets("Sheet2").Cells(Rows.count, 1).End(xlUp).Offset(1, 0)
Rows(gyou).Delete Shift:=xlShiftUp
End If
gyou = gyou + 1
Loop
Case vbNo
MsgBox "「処分」データは移動されませんでした。"
End Select
End With
MsgBox MoveWord & "は、" & count & "件でした。"
End Sub
No.1ベストアンサー
- 回答日時:
間違えているところ
最初に
SyobunWord = "処分"
としているのに、
If InStr(word, MoveWord) >= 1 Then
となっている。
If InStr(word, SyobunWord) >= 1 Then
とすべき。
あと、コピーしたものを消していって上に詰めていくので、下から検索しないとだめです。
例えば、上からすると1番目で見つかって削除されたら、2番目にあった行が1行目に移動してしまいます。なので、ずれます。
ということで、以下の様になります。
Private Sub cmdmSyobun_Click()
Dim SyobunWord As String
Dim gyou As Long
Dim word As String
Dim LastRow As Long
Dim hantei As Integer
Dim count As Integer
Dim baseB As Workbook
Dim baseS As Worksheet
SyobunWord = "処分"
Set baseB = ThisWorkbook
Set baseS = baseB.Worksheets("Sheet1")
baseS.Activate
With Worksheets("Sheet1")
hantei = MsgBox("「処分」データを移動しますか?", vbYesNo)
Select Case hantei
Case vbYes
count = 0
gyou = Range("A" & Rows.count).End(xlUp).Row
LastRow = baseS.Cells(Rows.count, 1).End(xlUp).Row
Do While Cells(gyou, 4) <> ""
word = Cells(gyou, 4)
If InStr(1, word, SyobunWord) >= 1 Then
count = count + 1
Rows(gyou).Copy Worksheets("Sheet2").Cells(Rows.count, 1).End(xlUp).Offset(1, 0)
Rows(gyou).Delete Shift:=xlShiftUp
End If
gyou = gyou - 1
If gyou = 0 Then Exit Do
Loop
Case vbNo
MsgBox "「処分」データは移動されませんでした。"
End Select
End With
MsgBox MoveWord & "は、" & count & "件でした。"
End Sub
早速教えて頂きましてありがとうございました。
ネットで調べたときに、下から検索するというのを見つけ自分なりに考えてコードを書いてみたのですが、どうもうまく動かずでした。
教えていただき、改めてコードを見て、動きを確認し、希望通りの動きをしたのでもう感動モノでした。
本当にありがとうございました。他にも似たようなことをしたい箇所がありますので、このコードを元にまた自分で考えてチャレンジしたいと思いました。本当に助かりました。ありがとうございました。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) Excelで下記のようにマクロを作ったところ、一回目は実行できたのですが、二回目以降「実行時エラー1 1 2022/03/25 08:08
- Visual Basic(VBA) 3つのプロシージャをまとめたら実行時エラー発生で対応不能 6 2022/05/17 01:47
- Excel(エクセル) マクロで最終行から上に検索を逆にしたい 1 2022/05/17 18:27
- Visual Basic(VBA) 【前回の続き続きです、ご教示ください】VBAの記述方法がわかりません。 2 2022/08/24 20:49
- Visual Basic(VBA) いつもお世話になっております、VBAで教えて頂きたいのですが 2 2022/05/05 22:20
- Visual Basic(VBA) 【ご教示ください】VBAの記述方法がわかりません。 2 2022/08/12 21:28
- Visual Basic(VBA) VBA Userformで一部別シートに転記がしたいのですが 2 2023/05/24 13:08
- Visual Basic(VBA) VBA処理追加 こちらでご教示頂いたのですが回答完了させてしまいましたのでこちらからまた質問させてく 2 2022/10/27 09:57
- Visual Basic(VBA) VBAが止まります。 3 2022/08/31 14:09
- Visual Basic(VBA) Sheet「状況」から、分類の年齢別カウント数をSheet「D表」へ転記する下記マクロを作っています 7 2022/12/14 17:57
関連するカテゴリからQ&Aを探す
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
マクロで最終行を取得してコピ...
-
【VBA】条件に一致しない行を削...
-
空白を複数行一気に挿入するには?
-
Excel97 指定した行だけマク...
-
エクセルで空白行を削除する ...
-
数値に見えるものはすべて数値...
-
VB.net
-
関数入りの行挿入。。。上書き...
-
VBAでの重複データに色付け
-
ExcelのVBAについて
-
エクセルVBAでデータの蓄積方法?
-
Excelマクロの転記について
-
VBAで入力の結果を他のセルに反...
-
EXCEL VBAでA列にある空白行よ...
-
Excelで、あるセルの値に応じて...
-
【VBA】条件に一致しない行を削...
-
Access2003レポート:最終ペー...
-
列から特定の文字列検索→該当以...
-
縦に並ぶ大量の資格データを、...
-
エクセルで階層図を作る方法
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
エクセルで空白行を削除する ...
-
マクロで最終行を取得してコピ...
-
【VBA】条件に一致しない行を削...
-
数値に見えるものはすべて数値...
-
【VBA】条件に一致しない行を削...
-
エクセルのデータがない行には...
-
VB.net
-
Excel VBAでオートフィルタで抽...
-
マクロにて指定の文字間の文字...
-
VBAでの重複データに色付け
-
EXCEL VBAでA列にある空白行よ...
-
【至急】Excel 同一人物の情報...
-
Excel マクロ 検索結果を別シ...
-
Excel VBA オートフィルタの結...
-
Excel97 指定した行だけマク...
-
列から特定の文字列検索→該当以...
-
VBAで入力の結果を他のセルに反...
-
excel2021で実行できないマクロ...
-
エクセルのVBAで指定した行数の...
-
Access2003レポート:最終ペー...
おすすめ情報