• ベストアンサー

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

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

質問者が選んだベストアンサー

  • ベストアンサー
  • keithin
  • ベストアンサー率66% (5278/7941)
回答No.4

マクロで逐一削除してった方が簡単そうです。 E1に記入されてる内容を,B2:E7の範囲から削除する: 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さんのマクロでは,縦に2つW,Wと繋がっていると漏らします。

qwer098123
質問者

お礼

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

その他の回答 (4)

  • tom04
  • ベストアンサー率49% (2537/5117)
回答No.5

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

qwer098123
質問者

お礼

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

  • mt2008
  • ベストアンサー率52% (885/1701)
回答No.3

手抜きマクロですがこんな感じでどうでしょう。 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

qwer098123
質問者

お礼

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

  • tom04
  • ベストアンサー率49% (2537/5117)
回答No.2

こんばんは! 一例です。 必ず範囲指定してマクロを実行してみてください。 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

qwer098123
質問者

お礼

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

noname#203218
noname#203218
回答No.1

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までコピペで完了です。

qwer098123
質問者

お礼

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