VBAでセル範囲の「名前の定義」の有無を取得

このQ&Aのポイント
  • エクセルのセル範囲に名前の定義を定義していますが、その有無を取得するためにVBAを使用する方法について教えてください。
  • 名前の定義されたセル範囲を変更する際に、エラーが発生してしまいます。正しい方法で名前の定義の有無を取得して分岐させる方法を教えてください。
  • エラーで判断するのではなく、名前の定義の有無を確認して処理を分岐する方法について教えてください。
回答を見る
  • ベストアンサー

VBAでセル範囲の「名前の定義」の有無を取得

エクセルのセル範囲(結合セル)にいろいろな名前を定義してあります。 名前の定義されたセル範囲を変更した場合、マクロが動くようにしたいのです。 ところが、名前の定義のないセルを変更すると 「実行時エラー1004、アプリケーション定義またはオブジェクトの定義のエラーです」 になってしまいます。 一応、下記のような方法で解決はできましたが、エラーで判断するのではなく、名前の定義の有無を取得して分岐させるのが正しい?やりかたなのではと思います。 ご教示いただけましたら幸いです。 Private Sub Worksheet_Change(ByVal Target As Range) Dim x As String On Error Resume Next x = Target.Cells(1).Name.Name On Error GoTo 0 If x = "" Then Exit Sub Select Case Target.Cells(1).Name.Name Case "住所" Range("送付先住所").Value = Target.Value Case "氏名" Range("送付先氏名").Value = Target.Value End Select End Sub

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

  • ベストアンサー
  • okormazd
  • ベストアンサー率50% (1224/2412)
回答No.1

エラーで判断するのが正しいやり方ではないなどとは言えないと思います。 それで安全に動けばいいのではないですか。 nameを調べるなら、全部のnameにあたるしかないでしょう。 次のようなコードでどうでしょう。 Private Sub Worksheet_Change(ByVal Target As Range) Dim x As String, ad As String, lad As Integer ad = Target.Address lad = Len(ad) For Each nm In ActiveWorkbook.Names If ad = Right(nm.RefersTo, lad) Then x = Target.Name End If Next If x = "" Then Exit Sub Select Case Target.Name.Name Case "住所" Range("送付先住所").Value = Target.Value Case "氏名" Range("送付先氏名").Value = Target.Value End Select End Sub

emaxemax
質問者

お礼

さっそくありがとうございます。 全部の「名前の定義」に総当りしなければいけないということは、ある任意のセルに名前が定義されているかどうかを直接取得する方法はないということなのでしょうか。

その他の回答 (3)

  • end-u
  • ベストアンサー率79% (496/625)
回答No.4

>「名前の定義」の有無を取得 するわけではないですが、提示の例題に限って言えば、 Private Sub Worksheet_Change(ByVal Target As Range)   Application.EnableEvents = False   With Target     Select Case True     Case Not Intersect(.Item(1), Range("住所")) Is Nothing       Range("送付先住所").Value = .Value     Case Not Intersect(.Item(1), Range("氏名")) Is Nothing       Range("送付先氏名").Value = .Value     End Select   End With   Application.EnableEvents = True End Sub このように、とにかくIntersectメソッド実行してNothing判定という方法もあるかもしれません。 ただ、 Range("住所")とRange("氏名")を含めたセル範囲を同時に選択してクリアしたり、 などはどういう対応になりますか? そのケースも考慮するなら、 それぞれIntersectメソッドの結果を取得して処理する必要があります。 Private Sub Worksheet_Change(ByVal Target As Range)   Dim r As Range   Application.EnableEvents = False   Set r = Intersect(Target, Range("住所"))   If Not r Is Nothing Then     Range("送付先住所").Value = r.Value   End If   Set r = Intersect(Target, Range("氏名"))   If Not r Is Nothing Then     Range("送付先氏名").Value = r.Value   End If   Application.EnableEvents = True End Sub でも提示のケースはあくまで例題なのですよね? それだけの用途なら関数をセットしておくほうが簡単な気がします。

emaxemax
質問者

お礼

ありがとうございます。 勉強になります。

  • okormazd
  • ベストアンサー率50% (1224/2412)
回答No.3

#1です。 補足について、 Rangeオブジェクトのメンバーに、nameを持つかどうかの判定できるようなプロパティはないと思います。 したがって、総当たりになります。 このような場合エラーで判断する方法もありかと思いますが、質問の場合はエラーの限定がし難い(1004じゃ広すぎる)ので、適切ではないかもしれません。

emaxemax
質問者

お礼

ありがとうございます。

  • kybo
  • ベストアンサー率53% (349/647)
回答No.2

以下の様な記述でもいいです。 Private Sub Worksheet_Change(ByVal Target As Range) Dim x As String Dim N As Name For Each N In ActiveWorkbook.Names If Not Intersect(Target, Range(N.RefersToLocal)) Is Nothing Then x = N.Name Exit For End If Next N If x = "" Then Exit Sub Select Case x Case "住所" Range("送付先住所").Value = Target.Value Case "氏名" Range("送付先氏名").Value = Target.Value End Select End Sub

emaxemax
質問者

お礼

ありがとうございます。 この方法も総当りで調べるのですね。 直接、名前の定義の有無を取得する方法はないのですね?

関連するQ&A

  • エクセルVBAでTargetのセルに設定された「名前の定義」の取得方法は?

    例えば、A1、B2、C3セルに「名前の定義」で、それぞれ入力A、入力B、入力C という名前がつけてあります。 それらのセルに入力があった場合、Select Caseで分岐させ作動するマクロをつくりました。 簡略化すると以下のようなもので、一応正しく作動します。 Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, Range("入力A,入力B,入力C")) Is Nothing Then Exit Sub Select Case Target.Address(0, 0) Case "A1" MsgBox "A処理します。" Case "B2" MsgBox "B処理します。" Case "C3" MsgBox "C処理します。" End Select End Sub ただ、せっかくセルに名前を定義してあるのに、個々の入力セルの判定をTarget.Addressでしているのが不満です。 ( ̄~ ̄;) 定義された名前を使えないかと以下のようにやってみましたが実行時エラーで「サポートしてません」となってしまいます。 (T.T) Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, Range("入力A,入力B,入力C")) Is Nothing Then Exit Sub Select Case Target.Names.Name 'ここでエラー Case "入力A" MsgBox "A処理します。" Case "入力B" MsgBox "B処理します。" Case "入力C" MsgBox "C処理します。" End Select End Sub どうやったら、Targetに設定されている名前を取得できるのでしょうか? (^∇^`)? 実際の例はもっと対象が多いので、Select Caseを使わない以下の方法は避けたいのです。 If文の羅列(これでも正しく作動はします。) Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, Range("入力A,入力B,入力C")) Is Nothing Then Exit Sub If Not Intersect(Target, Range("入力A")) Is Nothing Then MsgBox "A処理します。" ElseIf Not Intersect(Target, Range("入力B")) Is Nothing Then MsgBox "B処理します。" Else MsgBox "C処理します。" End If End Sub なにとぞよろしくお願いします。 (o。_。)oペコッ

  • VBAで別の列のセルにも色付け~2

    WINDOWS XP EXCELL 2003です。 いつもお世話になります。 ご迷惑とは重々と承知しながら再度質問させていただきます。 1 御指導を賜りたいのは、 現在A列には月度を示す 01~12 が入力され月別にセルの背景色を塗りつぶしていますがこれをA列用のマクロを工夫してF列にも同様に適用したい。 例えば参照図で言うと A7 05 ピンク  A8 05 ピンク A9 06 ライトブルー  A10 07 草色 等のように ※ 参照図のF列のセルには背景色は適用していません。 2 参照図のそれぞれの設定は、   ※ 計画 と 生産はセル位置だけの違いで生産の方は割愛します。 D1 ユーザー定義 mm/dd D2 ユーザー定義 200000 D3 数値 A7 ユーザー定義 mm マクロ ボタン「計画入力」 Sub 計画入力() Dim GYOU '追加 GYOU = Range("C65536").End(xlUp).Row + 1 Cells(GYOU, 2).Value = Range("D1").Value Cells(GYOU, 3).Value = Range("D2").Value Cells(GYOU, 4).Value = Range("D3").Value End Sub ボタン「セルセット」 Sub 計画セル()    Range("D1,D2,D3,D1").Select End Sub A列のセル塗りつぶし Private Sub Worksheet_Change(ByVal Target As Range) If Target.Row >= 8 And Target.Address = Cells(Rows.Count, "C").End(xlUp).Address Then Target.Offset(0, 0).Value = Date End If Dim c As Integer If Target.Column <> 2 Then Exit Sub If Target.Value = "" Then c = 0 Else On Error GoTo line Select Case Month(Target.Value) Case 1: c = 46 Case 2: c = 4 Case 3: c = 39 Case 4: c = 6 Case 5: c = 7 Case 6: c = 8 Case 7: c = 43 Case 8: c = 3 Case 9: c = 44 Case 10: c = 24 Case 11: c = 40 Case 12: c = 17 End Select End If Target.Offset(0, -1).Interior.ColorIndex = c Target.Offset(0, -1).Font.ColorIndex = IIf(c = 1, 2, 0) Exit Sub line: Target.Offset(0, -1).Interior.ColorIndex = 0 Target.Offset(0, -1).Font.ColorIndex = 0 End Sub 御指導よろしく御願いします。

  • Excel VBA セル範囲に名前をつける

    Excel VBA独学中の初心者です。 セル範囲に名前をつける方法で以下の2つの方法があるようです。 (1) 同じように動作しますが違いは有るのでしょう。 (2) 本質的に考え方または内部動作は違うのでしょうか。 お分かりの方教えていただけますと助かります。 --------------- '方法1 Sub 名前の定義1() Range("sheet1!A2:B3").Name = "名前1" End Sub '方法2 Sub 名前の定義2() Range("A1").Select ActiveWorkbook.Names.Add Name:="名前2", _ RefersTo:="=sheet1!A2:B3" End Sub

  • Worksheet_Change、名前の定義で分岐

    エクセル2010です。 Worksheet_Change イベントで、名前の定義で分岐させようと思います。 下記二つの方法は思いつきましたが、ほかにもっと良い方法はないでしょうか? 実際にはもっとたくさんの名前の定義があります。 ・Intersectで見る方法 Private Sub Worksheet_Change(ByVal Target As Range)   Select Case True   Case Not Application.Intersect(Target, Range("見積日")) Is Nothing     Range("有効期限").Value = Range("見積日").Value + 60   Case Not Application.Intersect(Target, Range("Trigger")) Is Nothing     If Target(1).Value = "AAAA" Then '(1)は結合セルクリア対策       MsgBox "BBBBを入力してください。"       Range("BBBB").Select     Else       Range("BBBB").MergeArea.ClearContents     End If   Case Not Application.Intersect(Target, Range("BBBB")) Is Nothing     If Target(1).Value = "日付入力" Then       Range("BBBB").Value = InputBox("日付を入力してください。")     End If   End Select End Sub ・アドレスで見る方法 Private Sub Worksheet_Change(ByVal Target As Range)   Select Case True   Case Target(1).Address = Range("見積日")(1).Address     Range("有効期限").Value = Range("見積日").Value + 60   Case Target(1).Address = Range("Trigger")(1).Address     If Target(1).Value = "AAAA" Then '(1)は結合セルクリア対策       MsgBox "BBBBを入力してください。"       Range("BBBB").Select     Else       Range("BBBB").MergeArea.ClearContents     End If   Case Target(1).Address = Range("BBBB")(1).Address     If Target(1).Value = "日付入力" Then       Range("BBBB").Value = InputBox("日付を入力してください。")     End If   End Select End Sub

  • エクセル VBAで範囲に名前を定義する

    Sub 範囲import設定() Sheets("Format").Select Range("A1").Select Selection.CurrentRegion.Select ActiveWorkbook.Names.Add Name:="import", RefersToR1C1:="=Format!R1C1:R26C7" End Sub 「マクロの記録」でCTRL + * で全データ範囲を選択して"import"という名前を定義したところ 上のようなコードになりました。全データ範囲は毎回違うのですが、ごらんのようにセル番号 で指定されてしまいます。そのつど異なる全データ範囲に名前を定義するにはどうすればいいのでしょうか。 よろしくお願いします。

  • 【VBA】初心者です セルの貼り付けについて

    VBAについてご質問です 以下のようなVBAを、こちらの質問等を参考に作成したのですが、 シートにそれぞれデータを貼り付ける際、値貼り付けになってしまいます 書式ごと貼り付けるようにしたのですが、どのように改良すればよいでしょか ご教示よろしくお願いいたします Sub ぶんるい() Dim r As Long Dim Target As Variant For r = 14 To 100 Select Case Cells(r, "D").Value Case "大阪" Target = "大阪" Case "名古屋" Target = "名古屋" Case Else Target = "" End Select If Target <> "" Then Worksheets(Target).Range("A65536").End(xlUp).Offset(1).Resize(1, 14).Value = _ Cells(r, "H").Resize(1, 14).Value End If Next r End Sub

  • VBA で名前の定義をしたいのですが・・・

    初心者です。 いろいろ試してみたのですが、だめでした。 ご教授ください。 対象という名前を定義させたいと思っています。 定義の参照範囲は可変です。 定義したい範囲はSheet1のAA3からAAの最終行までです。 それでマクロの自動記録から名前の定義のコードを取ってきて 変数を代入してみましたが、参照範囲を正しく取ってきてくれませんでした。 Sub test() '対象の名前を定義する Dim n As Long n = Sheets("Sheet1").Cells(Rows.Count, 27).End(xlUp).Row Sheets("Sheet1").Select Range(Cells(3, 27), Cells(n, 27)).Select ActiveWorkbook.Names.Add Name:="対象", RefersToLocal:="=Sheet1!R3C27:RnC27" End Sub RefersToLocal:="=Sheet1!R3C27:RnC27"の部分を RefersToLocal:="=Sheet1!R3C27:R&n&C27" RefersToLocal:="=Sheet1!R3C27:"R"&n&"C27"" にしてもだめでした。 うまく範囲をとってくれる方法を教えてください。 お願いします。

  • [VBA] セルの色を塗りつぶす

    条件付き書式では出来ないみたいなので、VBAに挑戦しましたが苦労しています。 Win 8, excel 2010です。 「ある1つのセルが100の時、その左横の4列をある色で塗りつぶす」 という事を行いたいのですが、 ネットで調べたものをちょっとアレンジしてみましたが Sub change(ByVal Target As Range) Dim myColor As Variant If Target.Count <> 1 Then Exit Sub If Target.Column <> 4 Then Exit Sub Application.EnableEvents = False Select Case Target.Value Case 100 myColor = 3 Case Else myColor = xlNone End Select Cells(Target.Row, 1).Resize(1, 4).Interior.ColorIndex = myColor Application.EnableEvents = True End Sub change(関数名)の横に引数があるから(参照渡し???) マクロに表示されないという情報を 見つけたのですが、色々やっても訳が分からなくなりました。 どうすれば実行できるようになるのでしょうか?

  • VBAにおけるセルの名前の参照方法

    現在、Aシート、Bシートがあり、BシートのA1セルに test という名前を付けました。(範囲はブック) Aシートが再計算されれば、BシートのA1セルをメッセージボックスで表示したいのですが、調べましたが、よくわかりませんでしたので、詳しい方教えてください。 範囲はブックになっているし、他に同じセルの名前もつけれないようになっているので、 このような記述で大丈夫かと思いましたがエラーが出でしまいました。 なぜでしょうか?やはりわざわざ毎回シート名から記述が必要なのでしょうか? Private Sub Worksheet_Change(ByVal Target As Range)      MsgBox (Range("test").Value) End Sub このようにシート名から書けば表示されました。 Private Sub Worksheet_Change(ByVal Target As Range)      MsgBox (Worksheets("B").Range("test").Value) End Sub

  • セルの値をシート名にするエクセルVBA

    件名のVBAを以下のように書きました B列の4からずっと下までのセルの値を次々とシート「ひな型」をコピーし増やしていくものです。 Sub テスト() ' ' Macro ' ' Dim target As Range Dim h As Range '見えてるセルを取得する。「全部隠れていた」場合も考える。 On Error Resume Next Set target = Worksheets("Sheet1").Range("B4:B" & Worksheets("Sheet1").Range("B65536").End(xlUp).Row).SpecialCells(xlCellTypeVisible) If target Is Nothing Then Exit Sub 'シートを増やしていく For Each h In target On Error GoTo errhandle Worksheets(CStr(h.Value)).Select On Error GoTo 0 Next Sheets("Sheet1").Select Exit Sub errhandle: Worksheets("ひな型").Copy after:=Worksheets(Worksheets.Count) ActiveSheet.Name = h.Value Resume End Sub これだと、一応思った通りにはなるのですが B列のセルに複数同じ名前があった時に、既に作ったシートの名前がある場合 それは無視するという風に実行したいです お知恵をお貸しくださいませ

専門家に質問してみよう