- ベストアンサー
ExcelVBAのrangeのdeleteの検出方法
end-uの回答
- end-u
- ベストアンサー率79% (496/625)
On Error Resume Next On Error GoTo 0 で挟んで処理するのが簡単だと思いますが 使いたくない場合は Sub test() With Workbooks.Add(xlWBATWorksheet) Dim r As Range Set r = .Sheets(1).Range("C3") r.Name = "check" MsgBox r Is Nothing MsgBox InStr(.Names("check"), "#REF!") > 0 r.Delete shift:=xlUp MsgBox r Is Nothing MsgBox InStr(.Names("check"), "#REF!") > 0 End With End Sub こんな感じでチェックできます。 名前定義や数式の参照エラーを使うと良いでしょう。
関連するQ&A
- VBA シートプログラムでRangeエラー
いつもお世話になっております。 Excel2003を使用しております。 シートに直接プログラムを書いています。 （例として、Sheet1とします） シートの内容が変わったときに、色々プログラムを実行していこうと思っているのですが、 Private Sub Worksheet_Change(ByVal Target As Range) のTargetが上手く取得できていない気がします。 今までは上手く動いていたのですが、 急にTargetの値に数値（セルに入力した値）が入ってしまうようになり 上手く組めなくて困っています。 Private Sub Worksheet_Change(ByVal Target As Range) Dim 開始1 As Range Dim 終了1 As Range Dim 開始2 As Range Dim 終了2 As Range Set 開始1 = Range("D5：D63") Set 終了1 = Range("E5：E63") Set 開始2 = Range("F5：F63") Set 終了2 = Range("G5：G63") If ThisWorkbook.ActiveSheet.ProtectContents Then '保護かかってたら End '強制終了 End If If Not Application.Intersect(Target, 開始1) Or Application.Intersect(Target, 実績日開始2) Is Nothing Then Call 開始(Target, 開始1, 開始2) ElseIf Not Application.Intersect(Target, 終了1) Or Application.Intersect(Target, 終了2) Is Nothing Then Msgbox "テスト！" End If End Sub '----------------------------------------------- Sub 開始(ByVal Target As Range, 開始1 As Range, 開始2 As Range) If Not Application.Intersect(Target, 開始1) Is Nothing Then MsgBox Target.Row End If If Not Application.Intersect(Target, 開始2) Is Nothing Then MsgBox Target.Row + 1 End If End Sub 全部シートに書いています。 まだ、テスト段階のため適当なプログラムしか書いておりません。 （指定範囲が変更された場合に、Msgboxを出したりなど 単純なことしかしていません） どこが悪いのか、教えて頂けないでしょうか？ よろしくお願い致します。
- ベストアンサー
- Excel（エクセル）
- マクロFind検索で見つからなかった時の対処
エクセル2013です 以下のコードを作成しましたが .Rowが色で塗られ 「型が違います」でERRになります。 .Columnの方はERRでなく なぜ.Rowの方がERRなのでしょうか？ よろしくお願いします。 Dim 検索行番号 As Range Dim 判定列番号 As Range Dim 検索列番号1 As Range Dim 検索列番号2 As Range Set 検索行番号 = Rows(1).Find("みかん").Column If 検索行番号 Is Nothing Then MsgBox "みかんが有りません。" End If Exit Sub Set 判定列番号 = Rows(1).Find("りんご").Column If 判定列番号 Is Nothing Then MsgBox "りんごが有りません。" End If Exit Sub Set 検索列番号1 = Range("B:B").Find("大箱").Row If 検索列番号1 Is Nothing Then MsgBox "大箱が有りません。" End If Exit Sub Set 検索列番号2 = Range("B:B").Find("小箱").Row If 検索列番号2 Is Nothing Then MsgBox "小箱が有りません。" End If Exit Sub
- ベストアンサー
- Excel（エクセル）
- VBAでのエラー対処について
現在仕事でVBAと悪戦苦闘しています。 下記のマクロを実行すると、実行時エラー'13':型が一致しません。 と表示されます。 初心者で対処法がわかりません。 よろしくお願いします。 Sub Macro1() dat = InputBox("検索値") Range("A1").Activate Cells.Find(What:=dat, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _ xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _ , MatchByte:=False, SearchFormat:=False).Activate gegyo = ActiveCell Do Cells.FindNext(After:=ActiveCell).Activate If dat = ActiveCell Then If gegyo = ActiveCell.Row Then End Rows(ActiveCell.Row - 1 & ":" & ActiveCell.Row - 1).Delete Shift:=xlUp Range("A" & ActiveCell.Row - 1).Activate Rows(ActiveCell.Row + 1 & ":" & ActiveCell.Row + 1).Delete Shift:=xlUp Rows(ActiveCell.Row & ":" & ActiveCell.Row).Delete Shift:=xlUp End If gegyo = ActiveCell.Row Loop End Sub
- ベストアンサー
- オフィス系ソフト
- マクロ 検索できなかった検索値を表示したい
C列を複数の検索値で検索して見つからなかった検索値が 一つでもあればその検索値をメッセージBOXに表示した上で どの検索値であっても同じ処理をしたいです。 全て検索できた場合は別の処理をしたいです。 今自力で出来るのは以下の記述ですが 同じ処理を6回も記述しておりメンテしにくいです。 また、記述順で最初に見つからなかった検索値だけしか 表示できない（それでも問題は無いです）という弱点もあります。 他に方法はありますでしょうか？ 配列関連は自力で作成出来ませんので他の方法にてアドバイスを いただけたらと思います。 C列には果物名がランダムに10,000行入力されています。 検索値を ・みかん ・りんご ・バナナ ・いちご ・すいか ・メロン としてそれらが全て存在するか検索し一つでも存在しない場合は その検索値をメッセージBOXに表示した上で どの検索値であっても同じ処理を行う。 全て検索できた場合は次の処理を行う。 Sub 実験2() Dim 範囲 Set 範囲 = ThisWorkbook.Worksheets("マスタ").Columns("C:C") Set rngFind = 範囲.Find("みかん") If rngFind Is Nothing Then MsgBox "ファイル【みかん】が取込まれていません。", vbExclamation, "【警告】" MsgBox "今までの作業を保存しないで" & vbCrLf & _ "プログラムを終了します", vbExclamation, "終了" MsgBox "ただし【マスタ】はすでに削除されています。 " & vbCrLf & _ "必ず【マスタ更新】をやり直してください。", _ vbExclamation, "注意してください" ThisWorkbook.Sheets("マスタ").Select Cells.Select Selection.Delete Shift:=xlUp Range("A1").Select ThisWorkbook.Sheets("メニュー").Select Range("A2").Select End '終了 End If Set rngFind = 範囲.Find("りんご") If rngFind Is Nothing Then MsgBox "ファイル【りんご】が取込まれていません。", vbExclamation, "【警告】" MsgBox "今までの作業を保存しないで" & vbCrLf & _ "プログラムを終了します", vbExclamation, "終了" MsgBox "ただし【マスタ】はすでに削除されています。 " & vbCrLf & _ "必ず【マスタ更新】をやり直してください。", _ vbExclamation, "注意してください" ThisWorkbook.Sheets("マスタ").Select Cells.Select Selection.Delete Shift:=xlUp Range("A1").Select ThisWorkbook.Sheets("メニュー").Select Range("A2").Select End '終了 End If Set rngFind = 範囲.Find("バナナ") If rngFind Is Nothing Then MsgBox "ファイル【バナナ】が取込まれていません。", vbExclamation, "【警告】" MsgBox "今までの作業を保存しないで" & vbCrLf & _ "プログラムを終了します", vbExclamation, "終了" MsgBox "ただし【マスタ】はすでに削除されています。 " & vbCrLf & _ "必ず【マスタ更新】をやり直してください。", _ vbExclamation, "注意してください" ThisWorkbook.Sheets("マスタ").Select Cells.Select Selection.Delete Shift:=xlUp Range("A1").Select ThisWorkbook.Sheets("メニュー").Select Range("A2").Select End '終了 End If Set rngFind = 範囲.Find("いちご") If rngFind Is Nothing Then MsgBox "ファイル【いちご】が取込まれていません。", vbExclamation, "【警告】" MsgBox "今までの作業を保存しないで" & vbCrLf & _ "プログラムを終了します", vbExclamation, "終了" MsgBox "ただし【マスタ】はすでに削除されています。 " & vbCrLf & _ "必ず【マスタ更新】をやり直してください。", _ vbExclamation, "注意してください" ThisWorkbook.Sheets("マスタ").Select Cells.Select Selection.Delete Shift:=xlUp Range("A1").Select ThisWorkbook.Sheets("メニュー").Select Range("A2").Select End '終了 End If Set rngFind = 範囲.Find("すいか") If rngFind Is Nothing Then MsgBox "ファイル【すいか】が取込まれていません。", vbExclamation, "【警告】" MsgBox "今までの作業を保存しないで" & vbCrLf & _ "プログラムを終了します", vbExclamation, "終了" MsgBox "ただし【マスタ】はすでに削除されています。 " & vbCrLf & _ "必ず【マスタ更新】をやり直してください。", _ vbExclamation, "注意してください" ThisWorkbook.Sheets("マスタ").Select Cells.Select Selection.Delete Shift:=xlUp Range("A1").Select ThisWorkbook.Sheets("メニュー").Select Range("A2").Select End '終了 End If Set rngFind = 範囲.Find("メロン") If rngFind Is Nothing Then MsgBox "ファイル【メロン】が取込まれていません。", vbExclamation, "【警告】" MsgBox "今までの作業を保存しないで" & vbCrLf & _ "プログラムを終了します", vbExclamation, "終了" MsgBox "ただし【マスタ】はすでに削除されています。 " & vbCrLf & _ "必ず【マスタ更新】をやり直してください。", _ vbExclamation, "注意してください" ThisWorkbook.Sheets("マスタ").Select Cells.Select 'Sheets Selection.Delete Shift:=xlUp Range("A1").Select ThisWorkbook.Sheets("メニュー").Select Range("A2").Select End '終了 End If 次の処理 End Sub
- ベストアンサー
- オフィス系ソフト
- マクロで困ってます！
マクロでセル検索かけたらそのセルに設定していたハイパーリンクが外れてしまいます。 どうすればいいでしょうか・・？お力を貸してください！ バージョンは2007です！ コードは下記になります！ 同一ブック内の「データ」というシートにあるものを「検索更新」というシートで検索をかけるというものです。 宜しくお願いします！！ Sub 検索2() myLAST = Range("B" & ActiveSheet.Rows.Count).End(xlUp).Row + 1 If myLAST < 5 Then myLAST = 5 Range("A5:F" & myLAST).ClearContents Set myC = Sheets(1).Columns(3) _ .Find(What:=Range("E2").Value, _ LookIn:=xlValues, LookAt:=xlPart) ' If myC Is Nothing Then Exit Sub myCa = myC.Address Do myLAST = Range("B" & ActiveSheet.Rows.Count).End(xlUp).Row + 1 Range("A" & myLAST) = myC.Row Range("B" & myLAST) = myC.Offset(0, -1) Range("C" & myLAST) = myC.Offset(0, 0) Range("D" & myLAST) = myC.Offset(0, 1) Range("E" & myLAST) = myC.Offset(0, 2) Range("F" & myLAST) = myC.Offset(0, 3) Set myC = Sheets(1).Columns(3).FindNext(myC) If myC Is Nothing _ Or myCa = myC.Address Then Exit Do Loop Set myC = Nothing End Sub Sub 更新() myLAST = Range("A" & ActiveSheet.Rows.Count).End(xlUp).Row If myLAST < 5 Then myLAST = 5 For Each myC In Range("A5:A" & myLAST) If myC.Value = "" Then Exit Sub With Sheets(1) .Range("B" & myC.Value) = myC.Offset(0, 1) .Range("C" & myC.Value) = myC.Offset(0, 2) .Range("D" & myC.Value) = myC.Offset(0, 3) .Range("E" & myC.Value) = myC.Offset(0, 4) .Range("F" & myC.Value) = myC.Offset(0, 5) End With Range("A" & myC.Row & ":F" & myC.Row).ClearContents Next MsgBox "更新しました" End Sub
- ベストアンサー
- オフィス系ソフト
- ExcelVBA入力規則・条件付き書式の設定確認
環境 Windows7 Excel2010 セルに入力規則・条件付き書式が設定されているかを判定する方法をお教え願います。 試した方法は If Not Intersect(Range("A1").SpecialCells(xlCellTypeAllValidation), Range("A2")) Is Nothing Then MsgBox "入力規則が設定されていています。" End If If Not Intersect(Range("A1").SpecialCells(xlCellTypeAllFormatConditions),Range("A2")) Is Nothing Then MsgBox "条件付き書式が設定されていています。" End If 上記だと１つも設定されていないシート上で行うと実行時エラーとなります。 調べるとこのようなものを見つけました。 On Error Resume Next Range("A1").Validation.Type Err.Number <> 0 Then→エラーなら未設定となる。 できればエラーを使わず、判定を行いたいです。 ご教授をお願いいたします。
- ベストアンサー
- Excel（エクセル）
- 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
- ベストアンサー
- その他MS Office製品
- EXCEL VBAで
初心者です。 Sub Ksakujyo() Selection.SpecialCells(xlCellTypeBlanks).Select Selection.Delete Shift:=xlUp End Sub これでは対象セルが空白だったら該当するセルが見つかりませんと出ます。 それで If Range Is Nothing Then "対象がありません" End If を間に入れますが多分rangeのところが違うのでしょうね？ それとこれは選択範囲を選択してないと全ての行で削除されるみたいです。 かなり調べましたがお手上げです。 どなたかご教授よろしくお願いします。
- ベストアンサー
- その他MS Office製品
- マクロでキーワードを抽出して別のシートに挿入する
質問番号：4733370の質問と回答を勝手に引用させて頂きます。 セルA列にキーワードCCCが含まれていた場合に その行を削除してSheet2に貼り付けする・・・という下のマクロを 貼り付けの部分を挿入に変更したいのですが、なにぶんマクロ初心者 の為よくわからないので教えていただけないでしょうか・・ 宜しくお願い致します。 Sub キーワード切取貼付02() Dim r As Range, ur As Range, rr As Long Dim rd(), v Set r = Range("A1", Range("A65536").End(xlUp)).Find(What:="CCC", LookAt:=xlPart, After:=Range("A65536").End(xlUp)) If r Is Nothing Then 'なかったら MsgBox "ありません", vbCritical, "？ (￣～￣;)う～ん " Exit Sub '終了 Else 'あったら Do Until r Is Nothing '対象がなくなるまで ReDim Preserve rd(rr) '動的配列を用意 rd(rr) = r.Address(0, 0) '対象セルアドレスを配列に格納 rr = rr + 1 'カウント r.EntireRow.Cut Destination:=Sheets("Sheet2").Cells(rr, 1) '行の切り取り貼り付け Set r = Range("A1", Range("A65536").End(xlUp)).FindNext(r) '連続検索 Loop '繰り返し For Each v In rd() '各配列要素を If ur Is Nothing Then Set ur = Range(v) Else Set ur = Union(Range(v), ur) 'ユニオンに End If Next v ur.EntireRow.Delete 'ユニオンセルの属す行を一括削除 Set ur = Nothing Set r = Nothing End If MsgBox rr & "件をSheet2に移動しました。", vbInformation, " （￣ー￣）v" End Sub
- ベストアンサー
- オフィス系ソフト
- エクセルのVBAで、エラーになった場合の回避
excel2000 VBA エラーが発生した場合の処理の方法についてアドバイスをお願いいたします。 データベースのレコードを操作する、４つのプロシージャが下記の通りあります。 (1)最初(saisyo) (2)最後(saigo) (3)前(mae) (4)次(tugi) いきなり、(3)前、(4)次の処理を実行すると、エラーになってしまうのですが、これをなくしたい。(on error gotoステートメントを使えばいいのかなと考えていますが） ワークブックオープン時のイベントで(2)最後(saigo)を呼び出しているので、基本的にエラーは出ないのですが、いろいろレコードを触っている時に、(3)、(4)を実行するとエラーになるのがわずらわしいです。 どういう修正をコードに加えればいいか、アドバイスいただけるとありがたいです。 Public trg As Range Sub Saisyo() Set trg = Worksheets("data").Range("A1") Do Set trg = trg.Offset(1, 0) Loop Until trg.EntireRow.Hidden = False Call Tenki End Sub Sub Saigo() Set trg = Worksheets("data").Range("A60000").End(xlUp) Call Tenki End Sub Sub Mae() If trg.row >= 3 Then Do Set trg = trg.Offset(-1, 0) Loop Until trg.EntireRow.Hidden = False If trg.row = 1 Then MsgBox "これより前のレコードはありません" Call Saisyo Exit Sub Else Call Tenki End If Else MsgBox "これより前のレコードはありません!" End If End Sub Sub Tsugi() If trg.row < Worksheets("data").Range("A60000").End(xlUp).row Then Do Set trg = trg.Offset(1, 0) Loop Until trg.EntireRow.Hidden = False Call Tenki Else MsgBox "これより後ろのレコードはありません" End If End Sub Sub Tenki() 'レコードのtrgの値を入力シート(input)のBC１セルに表示させる Worksheets("input").Range("BC1").Value = trg End Sub
- ベストアンサー
- オフィス系ソフト
お礼
ありがとうございます。 正直に言って私の知らない”技”がいっぱいで、とても参考になりました。 InStr(.Names("check"), "#REF!") こういう使い方は思いもよりませんでした。 しっかりとじっくりとまた考えてみたいと思います。