EXCEL VBAで空白削除のマクロを作りましたが

質問

削除されません。
下記のとおりですが、どう考えても動きません、どなたか修正をお願いします。
初心者です。宜しくお願いします。

Sub Ksakujyo()
Dim ObjRange As Range
On Error Resume Next
Set ObjRange = Application.InputBox("削除範囲を選択して下さい。", "印刷範囲", Type:=8)
On Error GoTo 0
If ObjRange Is Nothing Then
MsgBox "キャンセルされました。"
End If
If Selection.Count = 1 Then Exit Sub
On Error Resume Next
Selection.SpecialCells(xlCellTypeBlanks).Delete shift:=xlShiftUp
Exit Sub
End Sub

回答No.4

keithin · ベストアンサー

こんなカンジですかね？

sub macro3()
　dim Target as range
　on error resume next
　set target = application.inputbox("目的のセル範囲を選んでください", type:=8)

　if target is nothing then
　　msgbox "キャンセルされました"
　　exit sub
　end if

　if target.count = 1 then
　　msgbox "複数個のセルを選んでください"
　　exit sub
　end if

　target.specialcells(xlcelltypeblanks).delete shift:=xlshiftup
end sub

お礼

ありがとうございます。
こうやるんですね。
さすがですね、でも自分ではまだまだ出来ないですが。
ありがとうございました。

回答No.5

mu2011

NO2です。
>キャンセルしたときにデバッグでオブジェクトが必要ですと、出ますが？
　⇒最初の「On　Error Resume Next」があれば以下の定義は不要です。
　　因みに「End Sub」の直前の「Exit Sub」はMsgbox直後に置いた方がよいのでは
　　ないでしょうか。

お礼

わかりました。
ありがとうございました。

回答No.3

mt2008

ANo.1です。

> つまりIf Selection.Count = 1 Then Exit Sub
> のExit Subは入らないってことですね。

違います。
削らないで下さい、必要な箇所です。
私が回答したのは、ただ単に
If Selection.Count = 1 Then Exit Sub
の前に　ObjRange.Select　を一行追加して、InputBoxで指定した範囲を選択しなさいと言う意味です。

お礼

わかりました。
ありがとうございます。

回答No.2

mu2011

取り敢えず、「On Error GoTo 0」と２個目の「On Error Resume Next」は不要です。
SelectionはObjRangeではないでしょうか。

お礼

解答ありがとうございます。
しかし、これがないとキャンセルしたときにデバッグでオブジェクトが必要ですと、出ますが？

回答No.1

mt2008

[F8]でステップ実行して見ましたか？

If Selection.Count = 1 Then Exit Sub
の行でExitしていると思います。
Application.InputBoxで削除範囲を指定していますが、その範囲が「Select」された訳では無いからです。
この時点でSelectされているのはマクロ起動前にアクティブなセルです。
If Selection.Count = 1 Then Exit Sub
の前に　ObjRange.Select
を一行追加して指定した削除範囲を「Select」しましょう。

お礼

解答ありがとうございます。
つまりIf Selection.Count = 1 Then Exit Sub
のExit Subは入らないってことですね。
それでObjRange.Selectを追加して

Sub Ksakujyo()
Dim ObjRange As Range
Set ObjRange = Application.InputBox("削除範囲を選択して下さい。", "印刷範囲", Type:=8)
If ObjRange Is Nothing Then
MsgBox "キャンセルされました。"
End If
ObjRange.Select
If Selection.Count = 1 Then
On Error Resume Next
Selection.SpecialCells(xlCellTypeBlanks).Delete shift:=xlShiftUp
End If
End Sub
となりましたが、これでも削除が実行されません。
？？？うーーん、わからない。
宜しくお願いします。

補足

あー、成る程、
Application.InputBoxで削除範囲を指定していますが、その範囲が「Select」された訳では無いからです。
この時点でSelectされているのはマクロ起動前にアクティブなセルです。
一つのセルでなく、３つ位セルを選択した状態でマクロを実行すると良くわかりますね。
そういうことだったんですね。
しかし、[F8]でステップ実行して見ると
Selection.SpecialCells(xlCellTypeBlanks).Delete shift:=xlShiftUp
に黄色の帯がかからず次のEnd Ifまで飛び越えます。
実行されてないってことですよね？

でここからどうすればよいでしょうか？
宜しくお願いします。