• ベストアンサー

任意のセル選択範囲内のセルの名前のコレクション

任意に選択したセル範囲内のセルの名前のコレクションを取得したいと考えています。 On Error Resume Next For Each 名前 In Selection    処理内容 Next On Error GoTo 0 と、すると取得することは可能なんですが、全てのセルを検索するため範囲が大きいと時間が掛かります。 Namesコレクションを利用して、セルアドレスがセル範囲に入っているか?を調べる方法も考えたのですが、これまた時間が掛かります。 どなたか?詳しい方!こんな方法もあるよ!!っての教えて頂けないでしょうか?宜しくお願い致します。

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

  • ベストアンサー
  • Wendy02
  • ベストアンサー率57% (3570/6232)
回答No.2

vba_minaraiさん、こんばんは。 ご質問の最終的な目的が良く見えないので、テクニックのみの話に終始してしまいます。 ただ、実際のコーディングでは、Names(名前定義)をVBAで使う方法は避けたほうがよいです。オブジェクトブラウザで調べてみれば分りますが、曖昧な要素をもっているので、いわゆる「明示的」というVBAの前提からは外れてしまいます。 名前定義は、ある意味ワークシートの定数で、VBAでは、Formula として文字列扱いになっています。しかし、本来、Formulaは、Rangeオブジェクトなどの引数にはふさわしくありません。On Error トラップでも良いようですが、やはり見栄えが良くありません。 具体的な内容がわかりませんので納得させられないような気がしますが、通常、VBAでは、名前定義ではなく、Public Const にして、アドレスのリストを作って、配列変数にしてから、Unionでつなぐか、ローカル変数にして、個々のアドレスをUnionでつなぐかで設定します。 以下のように、Rangeオブジェクトの中に、数式文字列を入れる方法はありますが、私は、通常、このような曖昧なコードは書きません。 '------------------------------------------- Sub NamesTesting() Dim myName As Name Dim ShName As String ShName = ActiveSheet.Name If TypeName(Selection) <> "Range" Then Exit Sub For Each myName In Names  If myName.RefersTo Like "=" & ShName & "!*" Then   If Not Intersect(Range(myName.RefersToLocal), Selection) Is Nothing Then     Range(myName.RefersToLocal).Interior.ColorIndex = 3   End If  End If Next End Sub '-------------------------------------------

vba_minarai
質問者

補足

いつもいつもいつも適切なご指導有難う御座います。 >Names(名前定義)をVBAで使う方法は避けたほうがよいです。オブジェクトブラウザで調べてみれば分りますが、曖昧な要素をもっているので、いわゆる「明示的」というVBAの前提からは外れてしまいます。 このように、何度も名前についてのご指導は、痛感しております。しかし、ご指導頂いて置きながら、名前に固執しているには理由があります。 本来は、マクロを組む人間が完結したものを作る必要があると思いますが、今やろうとしていることは、エクセルに慣れていない人も名前さえ定義すれば、フレキシブルに拡張できるようなものが出来ないか?と試行錯誤しております。 カード型データ的なものを考えていますので、アクセスとの連携も考えています。 いつも、抽象的な質問にもかかわらす丁寧なご指導有難うございます。

その他の回答 (2)

  • taocat
  • ベストアンサー率61% (191/310)
回答No.3

こんばんは。 こんな方法もあるよ・・・(^^;;; >任意に選択したセル範囲内のセルの名前のコレクションを取得したい ということは、 「名前定義されたセル(範囲)」に、 「任意に選択したセル(範囲)」が 少しでも掛かっていたらその名前を全て取得するんですね? 例えば、 Sheet1    名前P: B2:B7    名前Q: D5:F10    名前R: H1:J6 Sheet2    名前S: A1:A5    名前T: C1:C5    名前U: E1:E5 として、選択した範囲が、「Sheet1のA4:E12」であれば、 「名前P」と「名前Q」を取得したい・・ですね? ----------------------------------------------- Sub test()  Dim myName  Dim myRange As Range  Dim myInSect As Range  On Error Resume Next  Set myRange = Selection  For Each myName In ActiveWorkbook.Names    Set myInSect = Application.Intersect(myName.RefersToRange, myRange)    If Not myInSect Is Nothing Then       MsgBox myName.Name    End If  Next myName End Sub --------------------------------------------- 何故エラートラップしてあるかは、それを外して確認して下さい。 また、必ずヘルプでRefersToRangeプロパティを覗いてください。 以上です。  

vba_minarai
質問者

補足

お礼が遅くなりまことに申し訳ありません。 ご指導頂いた内容は、何度も何度もよく読み理解していきたいと思います。本当に本当に有難う御座いました。今後とも宜しくお願い致します。

  • imogasi
  • ベストアンサー率27% (4737/17068)
回答No.1

>全てのセルを検索するため範・・ 本当ですか。信じられない。私もよく判りませんが。 Dim cl As Range For Each 名前 In Selection Msgbox cl.Value Next の場合は、全てのセルを検索すると思いますが。 ------- B4:C7にNameAと名前定義して シートのイベントプロシージュアーに Private Sub Worksheet_SelectionChange(ByVal Target As Range) Set a = Range("nameA") Set b = Intersect(Target, a) If b Is Nothing Then MsgBox "共通のセルでない" End If End Sub として、実行してみると、うまく反応するようです。 しかしこれがいろんなケースで、質問者のなさっている方法より 「処理が早い」かどうかは判りません。 ただ高等(??)なメソッド(Intersect)を使うので、コーディング行は少なくなるように思う。 飛び離れた2つの範囲のどちらかに入っているか、は Private Sub Worksheet_SelectionChange(ByVal Target As Range) Set a = Range("nameA") Set b = Range("nameB") Set c = Union(a, b) Set d = Intersect(Target, c) If d Is Nothing Then MsgBox "共通のセルでない" End If End Sub でできました。 回答に「自信あり」とは上記コードは少数例でテスト済みという意味ですのであしからず。

vba_minarai
質問者

補足

早速のご指導有難う御座います。 いつも、いつも有難う御座います。 >全てのセルを検索するため範・・ の点ですが、選択範囲の全てのセルをに訂正させてください。 >高等(??)なメソッド(Intersect)???私は、まだ、見たこともないメゾッドです。 メゾッド自体に、程度の高低があるのかどうかは、解りませんが、そのメゾッドが使えるかどうかは、使う側の技量が高度であるどうかは、絶対にあると思います。 仰るとおり、コーディング行は少なくなる=実行速度が速い可能性がかなり高いと言える場合が多い(単にループを回すとかの場合は明らかに該当しないと思いますがあ・・?)と思いますので、ご指導頂いた内容を、自分の血と肉となるようじっくり考えて習得したいと思います。 本当に、本当に有難う御座います。今後とも宜しくお願いいたします。

関連するQ&A

  • 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

  • アクティブセルと同列の最下段セル選択

    セルの範囲選択のやり方で悩んでいます。 アクティブになっているセルから、それと同列に有る文字・数値が入力された最下段のセルまでを範囲指定したいのです。 その際にセルは結合されている場合と、そうでない場合があります。 取得したセルアドレスは他にも使用したいので、出来る事ならアクティブセルと最下段のセルアドレスを別々に取得してから、その値を使って範囲指定できるようにしたいです。 宜しくお願い致します。

  • 選択範囲だけを相対値セルに変換

    選択範囲だけを相対値セルに変換 Sub test()   Dim c For Each c In Selection If c.HasFormula Then c.Formula = Application.ConvertFormula(Formula:=c.Formula, _ FromReferenceStyle:=xlA1, ToAbsolute:=xlRelative) End If Next 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列のセルに複数同じ名前があった時に、既に作ったシートの名前がある場合 それは無視するという風に実行したいです お知恵をお貸しくださいませ

  • 使用中のセル範囲に空白があるか取得するには?

    For Each r In ActiveSheet.UsedRange.SpecialCells(xlCellTypeBlanks) ’空白セルに対して処理を行なう Next r このようなコードの場合、使用中のセル範囲に空白がないとエラーになるので、 ループに入る前に、空白セルがあるかを取得したいのですが、 どういう方法があるのでしょうか?

  • 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

  • 複数の離れた選択範囲をコピーペースト

    エクセルでCtrlを押しながら複数の離れたセルを選択しています。 それを指定したセルに縦1列に並べる方法はありますか?(Sheet2のA1から下方向へ並べる) 順番が入れ替わっても問題ありません。 普通に行うと複数の選択範囲に対して実行できません。という警告が出ます。 他の方のよく似た質問の回答でVBAが見つかりましたが、その回答では選択したセルの位置関係をキープしたままの状態で貼り付けされるので、縦1列に並べるように改良して欲しいです? 宜しくお願いします。 Sub sample() On Error Resume Next Set base = Application.InputBox("コピー先セルを入力してください。", Type:=8) If base Is Nothing Then Exit Sub For Each a In Selection If b = "" Then b = a.Row: c = a.Column base.Offset(a.Row - b, a.Column - c) = a.Value Next End Sub

  • ExcelVBA 選択したセルの取得

    こんにちは。ゆきのです。 選択した範囲のセルに対して、Excelのマクロで 1回ずつ処理を行いたいと考えています。 まずセル数を取得したいのですが、  「selection.cells.count」でセル数を取得すると、  同じセルが複数回カウントされます。 またセルの範囲を取得したいのですが、  「selection.address」で範囲を取得すると、  重複したセルを含んだそれぞれの範囲が取得されます。 例えば、  (1)  「$A$1」を「ctl」+「左クリック」で3回選択した状態だと、  「selection.address」が「$A$1,$A$1,$A$1」となり、  「selection.cells.count」は「3」となります。  (2)  「ctl」+「左クリック」で「A1:B1」「A1:A2」を連続で選択した状態だと、  「selection.address」が「$A$1:$B$1,$A$1:$A$2」となり、  「selection.cells.count」は「4」となります。  ($A$1が2回カウントされます) この時、同じセルを複数回カウントせずにセル数を 取得することはにできるのでしょうか? (上の例の場合ですと、(1)が「1」、(2)が「3」と取得したいです。) また、複数選択で範囲を取得する場合に選択が重複したセルを 除いた状態の範囲を取得することはできるのでしょうか? 処理したセルを記憶させるなどの方法は考えてみたのですが、 別の方法はないかと思い、質問させていただきました。 どなたか、教えて頂けませんか?? よろしくお願いします。

  • Excel collectionについて VBA

    Dim Mydata As New Collection Dim i As Long Dim EndNumber As Long On Error Resume Next 'データを登録する間、エラーを無視する For i = 2 To EndNumber '2行目から最終行までチェック Mydata.Add Range("J" & i).Value, Range("J" & i).Value 'J列のデータ取得 Next i On Error GoTo 0 i = 1 For Each A In Mydata Worksheets("Sheet1").Range("A" & i).Value = A i = i + 1 Next A 現在見ているシートの重複しない項目を 別シートに書き込みしているプログラムになります。 様々なサイトを参考にさせて頂き、 上記のような結果になり、 文字列は取得できるようになりました。 しかし、もとになるデータがある位置に(例は、J列) 数値が入っていると上手くコレクションに入ってくれません。 J列に文字列(りんご、ごりらなど)が入っている場合は 重複しない項目がコレクションに格納されていきます。 J列に文字列(0,1)が入っていた場合、 重複しない項目もなにも無く、 ローカルのMydataの中には<変数無し>とありました。 このプログラムの何処を直せば、数値をコレクションとして取得できますか? ちなみに、EndNumberには最終行の数値が入っています。 >Mydata.Add Range("J" & i).Value, Range("J" & i).Value 'J列のデータ取得 .valueを.stringにしても効果はありませんでした。 回答よろしくお願いいたします。

  • on error 処理に関して

    on error goto での処理ルーチン内で、 さらに on error goto を出すことは可能でしょうか。 それとも、一度on errorを設定すると、エラーが発生した後では変更は不可なのでしょうか。 やりたいことは、 1回目と、2回目、3回目以降でやることとを変えたいのです。 例えば、メッセージを変えるとか。 この場合、 エラー処理の中で、何回目かを聞くことで、メッセージを変えることは出来ると思うのですが、 それはやらず、 他にも色々やることが多いので、別処理として飛びたいのです。 以下のようなイメージです。 err1: on error goto err2 resume next err2: on error goto err3 resume next err3: resume next 宜しくお願いします。

専門家に質問してみよう