ｴｸｾﾙﾏｸﾛVBA ｾﾙの空白判定後の行の削除 ★詳しくは画像もご確認ください｡ B､D､F､Hの列内のｾﾙを調べて空白だったら､そのとなりの対になる A､C､E､Gのｾﾙ…

人力検索はてな

ﾓﾊﾞｲﾙ版を表示しています｡PC版はこちら

ｴｸｾﾙﾏｸﾛVBA ｾﾙの空白判定後の行の削除

★詳しくは画像もご確認ください｡

B､D､F､Hの列内のｾﾙを調べて空白だったら､そのとなりの対になる
A､C､E､Gのｾﾙも含め上方向に削除していく処理をしたい｡

B､D､F､H列にあるものが商品名でして､
A､C､E､G列がその保管場所です｡

ですので､B､D､F､Hが空白のときはそのすぐ左横の保管場所ごと削除
していきたいのです｡商品名がある時には､保管場所も削ってはいけません｡

また､
ﾏｸﾛを開始する行はﾃﾞﾌｫﾙﾄで200行からとして､変えられるようにお願いします｡

ﾏｸﾛのみのご回答にﾎﾟｲﾝﾄを進呈いたします｡
どうかよろしくお願いいたします｡

●拡大する

●質問者: ﾘｾｰﾙ京都買取
●ｶﾃｺﾞﾘ:ｺﾝﾋﾟｭｰﾀ
○ 状態 :終了
└ 回答数 : 1/1件

▽最新の回答へ

▽1 ● a-kuma3
●300ﾎﾟｲﾝﾄ

ﾍﾞｽﾄｱﾝｻｰ

こんな感じでどうでしょう｡

Function is_blank_cell(c)
 is_blank_cell = IsEmpty(c) Or c.Value = ""
End Function

Sub condense_table()
 start_row = 200  ' 圧縮範囲の開始行
 For col = 1 To 7 Step 2  ' A, C, E, G 列
 last_row_1 = Cells(Rows.Count, col).End(xlUp).Row
 last_row_2 = Cells(Rows.Count, col + 1).End(xlUp).Row
 If last_row_1 > last_row_2 Then
 last_row = last_row_1
 Else
 last_row = last_row_2
 End If
 For r = last_row To start_row Step -1
 If is_blank_cell(Cells(r, col + 1)) Then
 Range(Cells(r, col), Cells(r, col + 1)).Delete Shift:=xlUp
 End If
 Next
 Next
End Sub

対象のｼｰﾄを選択した状態で､condense_table ｻﾌﾞﾙｰﾁﾝを実行してください｡

ﾘｾｰﾙ京都買取さんのｺﾒﾝﾄ
ありがとうございます｡なぜか実行されないで無反応なのですが､どうしてでしょうか｡

a-kuma3さんのｺﾒﾝﾄ
質問にあるように､200行目以降を行を詰める対象にしていますが､そこは間違いないですか？

ﾘｾｰﾙ京都買取さんのｺﾒﾝﾄ
す､すみません｡200行より前をお願いしたいのです｡

ﾘｾｰﾙ京都買取さんのｺﾒﾝﾄ
ありがとうございます！ｽﾀｰﾄを1からにしたらばっちりできました｡いつも感謝です｡

a-kuma3さんのｺﾒﾝﾄ
あ､｢200行まで｣だったのですね｡回答に書いた VBA は､A?H列で､それぞれ最後にﾃﾞｰﾀが入ってるところまでを処理対象にしちゃってますが､大丈夫ですか？

ﾘｾｰﾙ京都買取さんのｺﾒﾝﾄ
動いておりますし､処理ｽﾋﾟｰﾄﾞも速いので問題ないかと！お気遣いありがとうございます｡また困った時には別質問させていただきますね｡いつもありがとうございます｡