[[20180113072704]]　『名前の定義されたセルを条件付きで抽出する方法』（渚）　ページの最後に飛ぶ

『名前の定義されたセルを条件付きで抽出する方法』（渚）

特定の名前が定義されたセルを検索する方法を教えてください。

定義されたセルの値を取得する方法まではわかりました。
http://www.relief.jp/docs/excel-vba-get-value-named-cell-range.html

Sub 名前付きセルの値を取得する_ForEachNext()
　Dim rng As Range

　For Each rng In Range("顧客マスタ")
　　MsgBox rng.Value
　Next rng

End Sub

やりたいことは名前が定義されたせる("顧客マスタ")を条件付きで検索して別のシートに張り付けたいです。
名前の定義が("顧客マスタ１")("顧客マスタ２")("顧客マスタA")となっているセルすべてを取得したいです。

うまく伝えれたかわかりませんが、よろしくおねがいします。

＜使用 Excel：Excel2013、使用 OS：Windows8 ＞

こんなことでしょうか

 Sub test()
  Dim n As Name

  For Each n In Names
    If n.Name Like "顧客マスタ*" Then
        MsgBox n.Name
    End If
  Next

 End Sub

（マナ） 2018/01/13(土) 08:51

 簡単かと思ったら結構むずいですね
ポイントは名前判断するとろみたいですけど、どうもエラーをトラップするしかないみたいですね
ただエラーをトラップする以降が条件で判断出来ないのでエラーNOで判断してみました
範囲とか配列とかは適当にアレンジしてください。
Option Explicit
Sub 名前付きセルの値を取得する_ForEachNext()
Dim MyArry() As Variant
Dim rng As Range
Dim k As Long
k = 1
'多分いるでしょうから配列を用意して
ReDim MyArry(1 To 1, 1 To k)
'シートを明示して
With Sheets("Sheet1")
    '範囲は適当にアレンジしてください
    For Each rng In .Range("A1", .Range("A5")).Resize(, 5)
        'エラーはトラップして
        On Error Resume Next
        'デバックで確認
        Debug.Print rng.Name.Name
        Debug.Print Err.Number
        'エラーがなかったら
        If Err.Number = 0 Then
        '条件は適当にアレンジしてください
'            If rng.Name.Name = "顧客マスタ１" Or rng.Name.Name = "顧客マスタ２" Or rng.Name.Name = "顧客マスタA" Then
            If rng.Name.Name = "顧客マスタ１" Or rng.Name.Name = "顧客マスタ２" Then
                '配列に格納
                MyArry(1, k) = rng.Value
                MsgBox rng.Value
                'kをイックリメント
                k = k + 1
                '配列を拡張して
                ReDim Preserve MyArry(1 To 1, 1 To k)
            End If
        End If
    Next rng
End With
With Sheets("Sheet2")
    'Sheet2を初期化k
    .Cells.Clear
    '行列を入れ替えて
    .Range("A1").Resize(UBound(MyArry, 2), UBound(MyArry, 1)).Value = Application.Transpose(MyArry)
End With
'配列の開放
Erase MyArry
End Sub
(また一年生になったつもりで勉強してみとうと思う◎◎Man）

（色々あって） 2018/01/13(土) 11:43

＞If n.Name Like "顧客マスタ*" Then

シートレベルだとFalseになるので修正。

 Option Explicit

 Sub test()
Dim wsS As Worksheet, wsD As Worksheet
    Dim n As Name
    Dim rr As Range, r As Range
    Dim i As Long

    Set wsS = ActiveSheet
    Set wsD = Worksheets.Add

    For Each n In Names
        If n.Name Like "*顧客マスタ*" Then
            Set rr = n.RefersToRange
            If rr.Parent.Name = wsS.Name Then
                For Each r In rr
                    i = i + 1
                    wsD.Cells(i, 1).Value = n.Name
                    wsD.Cells(i, 2).Value = r.Address(0, 0)
                    wsD.Cells(i, 3).Value = r.Value
                Next
            End If
        End If
    Next

 End Sub

（マナ） 2018/01/13(土) 12:50

 >RefersToRange
こんなプロパティがあったんですね汗
これはいいですね
何かの時の為にメモしておきます
後、一度書き込むと編集出来なくなったんですね？
誤字脱字が多くてすみません

（色々あって） 2018/01/13(土) 13:18

まさかこんなに複雑になるとはおもいませんでした。
回答ありがとうございます。

自分のエクセルでマナさんのマクロを走らせたところ

 Set rr = n.RefersToRange
この箇所で定義エラーが発生しました。
名前の定義されたセルは３つ取得できましたが、4つ目でエラーが発生しました。
別の方のマクロも組まれているのでエラーが発生したかもしれまん。
回避方法はありますでしょうか。作った方に聞こうと思ってももういないので…
（渚） 2018/01/13(土) 20:24

＞4つ目でエラーが発生しました。

４つ目の参照範囲あるいは値はどうなっていますか
名前の管理で確認していただけますか、

（マナ） 2018/01/13(土) 21:09

自己解決しました
定義エラー前に

On Error Resume Next

これを追加すると全ての定義されたセルが取得できました。

とても勉強になりました。ありがとうございました

（渚） 2018/01/13(土) 21:40

試した内容も追記します。

4つ目がエラー発生したので4つ目のセルを消したところ3つ目のセルでエラーがでました。
なので4つ目自体には問題ないかと思います。
（渚） 2018/01/13(土) 21:43

コメント返信：

[ 一覧(最新更新順) ]

[[20180113072704]] 『名前の定義されたセルを条件付きで抽出する方法』（渚） ページの最後に飛ぶ

[[20180113072704]]　『名前の定義されたセルを条件付きで抽出する方法』（渚）　ページの最後に飛ぶ