マクロで、決まった範囲内の一定値のみの消去法は？

エクセルでＶＢＡを使って、図のようにある範囲において、指示した値（Ｗ）のセルを
を削除し、下図のように、上方向に移動させるのにはどのようにしたら良いでしょうか。
同一範囲を別な位置に　＝IF(B2="W","",B2)　をコピーする形を作って、作られた範囲を
さらに値のみコピーして後、その範囲を、空白セルを上方向に削除しようとしても、
見かけ上の空白セルで実際は削除されません。
マクロで作ろうとしましたがＶＢＡ初心者なので、わかりません。教えていただけないでしょうか。

No.4 ベストアンサー 回答者： keithin 回答日時： 2013/12/16 19:57

マクロで逐一削除してった方が簡単そうです。

Ｅ１に記入されてる内容を，Ｂ２：Ｅ７の範囲から削除する：
sub macro1()
　dim c as range
　dim a as variant
　a = range("E1").value

　set c = range("B2:E7").find(what:=a, lookin:=xlvalues, lookat:=xlwhole)
　do until c is nothing
　　c.delete shift:=xlshiftup
　　set c = range("B2:E7").find(what:=a, lookin:=xlvalues, lookat:=xlwhole)
　loop
end sub


別のマクロ：一括削除してみる
sub macro2()
　range("B2:E7").replace what:=range("E1").value, replacement:="", lookat:=xlwhole
　range("B2:E7").specialcells(xlcelltypeblanks).delete shift:=xlshiftup
end sub

＃「削除したくない空白」が「指定範囲」に紛れている場合は，空白ではなく例えば「エラー値」などに置換して削除する




＃一応指摘しておきます
ANo2さんのマクロでは，縦に２つＷ，Ｗと繋がっていると漏らします。

この回答へのお礼

お答え有難うございます。
試させていただきました。どちらもきっちりです。

またFINDの使い方をはじめて知りました。
随分簡明に書けているのに感心しました。
また答えを二つ有難うございます。
二つ目も非常に短い構文で表現され、勉強になります。

お礼日時：2013/12/17 00:23

No.5 回答者： tom04 回答日時： 2013/12/16 20:49

No.2です。

No.4さんのご指摘通りでした。
検証せずに投稿してごめんなさいね。
（No.4さん、どうもありがとうございました。）

一気に削除するコードを載せてもNo.4さんの二番煎じになりますので、
別のコードにしてみました。
今回も範囲指定した後にマクロを実行してみてください。

Sub Sample2()
Dim i As Long, j As Long
For j = Selection(1).Column To Selection(Selection.Count).Column
For i = Selection(Selection.Count).Row To Selection(1).Row Step -1
If Cells(i, j) = Range("E1") Then
Cells(i, j).Delete shift:=xlUp
End If
Next i
Next j
End Sub

※　削除の場合は後ろから！という基本的なコトを忘れていました。m(_ _)m

この回答へのお礼

試させていただきました。
Wを連ねてもパッチリです。
このような表現の仕方もあること、なるほどです。
新しいお答え有難うございます。

お礼日時：2013/12/17 00:33

No.3 回答者： mt2008 回答日時： 2013/12/16 19:12

手抜きマクロですがこんな感じでどうでしょう。

Sub Sample()
　　Dim nFlg, rOne, rTarget As Range
　　For Each rOne In Range("B2:E7")
　　　　If rOne.Value = Range("E1").Value Then
　　　　　　'E1と同じ値のセルが入っているセルを覚えておく
　　　　　　If rTarget Is Nothing Then
　　　　　　　　Set rTarget = rOne
　　　　　　　　nFlg = 1
　　　　　　Else
　　　　　　　　Set rTarget = Union(rTarget, rOne)
　　　　　　End If
　　　　End If
　　Next rOne
　　'覚えておいたセルを削除（上方向へシフト）
　　If nFlg = 1 Then rTarget.Delete Shift:=xlUp
End Sub

この回答へのお礼

お答え有難うございます。
試してみましたら、きちっと求めている表示になりました。流石です。
まだVBAの勉強不足ですべて理解しきっておりませんので、
あわてずに、しっかり自身で組めるようにしたいと思います。

お礼日時：2013/12/16 23:55

No.2 回答者： tom04 回答日時： 2013/12/16 19:02

こんばんは！

一例です。

必ず範囲指定してマクロを実行してみてください。

Sub Sample1()
Dim c As Range
For Each c In Selection
If c = "W" Then
c.Delete shift:=xlUp
End If
Next c
End Sub

こんな感じではどうでしょうか？m(_ _)m

この回答へのお礼

お答え早速試させていただきました。
こんなに簡明なマクロで期待どおりの配列が
得られました。
有難うございます。

お礼日時：2013/12/16 23:44

No.1 回答者： pidum 回答日時： 2013/12/16 19:02

VBAの知識が無いのであれば、関数で処理可能です。

ご参考まで。

B10に下記式コピペ
=INDEX(B:B,SMALL(IF(B$2:B$7=$E$1,99,ROW(B$2:B$7)),ROW(B1)))&""
上記式は配列式なので、シフトキー及びコントロールキーを押しながらエンターキーを押します。
B10の式が｛｝で括られてるのを確認出来たら式が完成です。
｛=INDEX(B:B,SMALL(IF(B$2:B$7=$E$1,99,ROW(B$2:B$7)),ROW(B1)))&""｝
括弧でくくられない場合は、B10セル選択し、数式バーにカーソルを合わせてくだい。

B10の式をE15までコピペで完了です。

この回答へのお礼

素早いお答え有難うございます。
マクロを使わずに配列式だけでできるとは!
あとでしっかり式を理解したいと思います。
今後の中で利用させていただきたいと思います。

お礼日時：2013/12/16 23:35