エクセルで名前の定義を自動化したい

質問

いつもお世話になっております。
添付のようにエクセルシートのA列に社名を入力したら、社名を名前にして行方向に「名前の定義」の範囲をD列からR列まで設定するようにしたいのですが。
これまでは私が都度やっていたのですがここでいろいろ教えてもらっているうちにだんだん欲が出てきた次第です。
目的は別シートの入力セルへの入力作業をこのシートに入力することでリストからの選択にしたいのです。

NETで調べてみたら数行のマクロで出来そうなのですがその数行が悲しいかな出来ないのでHELPです。

回答No.6

HohoPapa · ベストアンサー

>シートに移したら動かなくなります。
とのことから、
VBAのコードをシートモジュールに配置したいんですね？

>やりたいことはその都度行を選択してのマクロ実行(名前の登録）です
とのことから、
意図的に行選択されている場合にのみ
行選択されている行のみを対象に動作するようにしました。
つまり、任意セルが選択されている場合はメッセージを表示して
空振りします。

また、
>名前の残骸が増加するのですが
これも考慮したツモリです。

よかったら使ってみて
改修点があれば指摘してください。

Option Explicit

Sub RangeNameSet()

　Dim Myadr As String
　Dim MyRange1 As Range
　Dim MyRange2 As Range
　Dim MyName As String
　Dim tgRow As Long

　Myadr = Selection.Address(False, False)
　Myadr = Replace(Myadr, ":", "")
　If Me.Name <> ActiveSheet.Name Then
　　MsgBox ("選択されたシート用のマクロが選択されていません")
　　Exit Sub
　End If
　If IsNumeric(Myadr) = False Then
　　MsgBox "行が選択されていません。" '鬱陶しいなら削除
　　Exit Sub
　End If

　For Each MyRange1 In Selection.Rows
　　tgRow = MyRange1.Row
　　Set MyRange2 = Range(Me.Cells(tgRow, 4), Me.Cells(tgRow, 18))

　　MyName = ""
　　On Error Resume Next
　　MyName = MyRange2.Name.Name　'既名前を調べる
　　On Error GoTo 0

　　If MyName <> "" Then
　　　ThisWorkbook.Names(MyName).Delete
　　End If

　　If Me.Cells(tgRow, 2).Value <> "" Then
　　　MyRange2.Name = Me.Cells(tgRow, 2).Value
　　End If
　Next MyRange1

End Sub

注
一般には、処理の都度マクロを実行するのであれば
標準モジュールに配置します。
なにか事情があってシートモジュールに配置したいのかもしれないので
シートモジュールでのコードを考えてみました。
いや、それなら標準モジュールで。
とのことであれば指摘してください。）

お礼

HohoPapaさん
補足コメント以後、実際のシートに近い表を作成し色々試行してみて非常に大きな間違いに気づきました。
補足コメントを読まれる前にと思い追記します。間に合うことを祈って。

先ず目的は、Sheet1（顧客リスト）で定義した会社名に製品名を紐付けて、Sheet2（入力表）のA列で会社名をリストから選択したら、B列でその会社の製品名が選択入力できるようにしたいのです。

つまりSheet2のA列で同じ会社名を選んだらその会社の行がB列の選択肢に表示されるようにしたいのですが、質問の回答では会社名を上書きで変更してもB列の選択肢は最初にその行に紐付いた製品名が表示されてしまいます。

全く質問が間違っていました。
入力表のA列で選択した会社名を名前の定義の会社名からB列の入力対象行を決めてやる必要がありました。

具体的にどうするかは全く思いつきません、とにかく上の回答へのご対応は不要ですので取り急ぎアップします。意味が通じないかもしれませんが。

本当に無駄なお手数をかけてしまい申し訳ありませんでした。

補足

いつもお世話になっております。
自宅にてテストシートで試してみました。
当方が色々な使い方（上書き、追加、削除）を想定して色々試してみました。
複数行を選択してのマクロの実行でも問題なく、想定以上の使い勝手の良さでした。

不要な名前が削除されることも、同一社名の復活登録時の重複登録が回避できるし、すっきりして非常にGood！！

標準モジュールとシートモジュール等の使い分けは全く理解しておらずいつもは「シート」か「This workbook」を使っています。

このマクロは他のシートでも使う可能性もあるので、出来れば標準モードとの使い分けの基準など教えていただければありがたいです。

回答No.7

HohoPapa

>別シートの入力セルへの入力作業を
>このシートに入力することでリストからの選択にしたいのです
という要望に
>社名を名前にして行方向に「名前の定義」の範囲を
>D列からR列まで設定する
という手段をどのように絡めるツモリなのか疑問に思ってはいました。

>入力表のA列で選択した会社名を
>名前の定義の会社名からB列の入力対象行を決めてやる必要がありました
質問に添付した画像はSheet1（顧客リスト）ですね？

>意味が通じないかもしれませんが
はい、推測はできますが
コーディングできる内容ではありません。

これらのシート(入力表というシートを含め)のサンプルを
限りなく本物に近いレイアウトで示し
やりたいことを詳しく説明し
再質問したほうがいいと思います。

お礼

最悪の状況は避けられたようで少しは安心しました。
改めて質問させていただきます。

何度も本当にすみませんでした。

回答No.5

SI299792

詳しく調べていないのですが、名前にVBA で扱えない文字（シフトジスに無い文字）を使うと、普通のマクロでは削除できないようです。これをマクロで削除しようとすると、相当複雑になるようです。手作業で消した方が早いです。
　Ｂ列を入力する度に名前をつけたい。前の会社の残骸が残ってもいいというのであれば、改良版は無視して下さい。（てゆうかこの方法で削除は不可能）。これは、処理したい全てのシートに入れる必要があります。

　あなたの文章からは、Ｂ列に入力する度に名前をつけたいのか、後でまとめてボタンを押して名前をつけたいのか、読み取れないのですが、どっちですか。
　余計な事ですが、前の名前を削除しなくても、新しい名前をつければ、更新されます。であれば、これだけでいいです。
'
Private Sub Worksheet_Change(ByVal Target As Range)
'
　　If Target.Count > 2 Or Target.Column <> 2 Or Target.Row < 5 Then
　　　　Exit Sub
　　End If
'
　　ActiveWorkbook.Names.Add Target, "=$D$" & Target.Row & ":$R$" & Target.Row
End Sub

両方とも
　　　　On Error Resume Next
　　　　　　︙
　　　　On Error GoTo 0
は不要でした。

回答No.4

imogasi

#2です。
補足を踏まえて、もう一度やってみましたが、小生の思った通りになりました。
ーー
新規ブックで新規シートＳｈｅｅｔ１だけの状態で、プロジェクトエクスプローラーを出し、Ｓｈｅｅｔ１を見つけて、ダブルクリックし、その白紙の画面に私の回答の、コード部分をコピペしてください。
標準モジュールではありません。
そしてＳｈｅｅｔ１に戻り、Ａ列に会社名を、手入力で入れてください。
これでＡ列の当該セルに会社名の名前が付きます。
その後、左上部にある、名前ボックスをクリックすれば、名前が増えたことが確認できます。
ーー
後で気づいたのですが、質問者は、その行の、Ａ列ーＧ列などのセル範囲に名前を付けたいならば、少しコードが変わります（下記）。
Target.Name = Target.Value
↓
Range("A" & Target.Row & ":G" & Target.Row).Name = Target.Value
Ａ１０セルに、例えば、北野建築と入れてＥＮＴＥＲキーを押すと、名前ボックスは北野建築が増えて、それをクリックすると、シートのＡ１０：Ｇ１０が範囲指定されました。

回答No.3

SI299792

とっちを試しましたか。
F5を押してもマクロの窓に何も出て来ない。ということは、上の方法をやろうとしたのでしょう。
間違って、下のマクロを入れませんでした？
下のマクロは、シートモジュール用でF5では出てきません。正しくマクロが入っているか、確認して下さい。

前マクロに問題がありました。前の名前が残ってしまいます。例えば、B5にＡ社と入っていたのをＺ社に直し、他の列でＡ社を使わなければ、Ａ社とＺ社の両方の名前が付きます。多分まずいと思うので、一度全ての名前を消してからつけるように直しました。これは同じ社名があればエラーになります。
'
Option Explicit
'
Sub Macro1()
'
　　Dim Row As Long
　　Dim SName As Name
'
　　For Each SName In ActiveWorkbook.Names
　　　　SName.Delete
　　Next SName
'
　　For Row = 5 To Cells(Rows.Count, "B").End(xlUp).Row
　　　　ActiveWorkbook.Names.Add Cells(Row, "B"), "=$D$" & Row & ":$R$" & Row
　　Next Row
End Sub

複数のワークブックで使うのなら、個人用マクロブック(Personal.xlsb) にいれておくのも１つの方法です。

補足

何度もすいません。

やりたいことはその都度行を選択してのマクロ実行(名前の登録）です。
コードは作業対象シートにコピペしたつもりでしたが、ご指摘で確認してみたら標準モジュールに入っていました。
ここは使ったことが無いので、シートに移したら動かなくなります。
また、改良版は「この名前の構文が正しくありません」とエラーが出ます。

名前（B列）には「あいうえお」と入れてみて、最初のコードは標準モジュールでちゃんと動きます。

最初のコードは問題なく動き、上書きすると確かに前の名前が残っていますが問題は無いようです。（上書きした名前で別シートのリスト入力枠の選択肢に更新内容で表示されます）
但しこれを「別のシートで試した見たらだめでした」という事だったのですが、このまま使うと問題出るでしょうか？
同じ名前（会社名）を同時に使うことは無いので、名前の残骸が増加するのですが、他に悪影響でないならこれで使い始めようかと。

実際に使用するのは私ではなく、他の担当者で、すでに行を選んでマクロボタンを押すと名前が登録されて、入力用シートに選択肢として表示されることまで確認済なのですが。

回答No.2

imogasi

実質１－２行のＶＢＡでできるのではないですか。
ただし、キッカケをどうするか、
（１）Ａ列のセルのイベントを直、使う。
（２）コマンドボタンを使う。ユーザーが、認識して、クリックする１ステップを置く。
（３）その他ツールバーとかに設定する
など考え付きますが。（１）は思わぬトラブルがありそうで、個人的には怖い。
ーー
（１）ならば、
ＶＢＥ画面を出して
表示ープロジェクトエクスプローラーー
Ｓｈｅｅｔ１（新規ブックの当初のシート名の場合）のモジュールを選び、
（左のボックスで）Worksheet-（右のボックスで）Changeを選び
Private Sub Worksheet_Change(ByVal Target As Range)
End Sub
を出す。
ーー
中身は
Private Sub Worksheet_Change(ByVal Target As Range)
MsgBox Target.Address
If Application.Intersect(ActiveCell, Range("A2:A50")) Is Nothing Then
Else
MsgBox "名前づけ範囲内"
Target.Name = Target.Value
End If
End Sub
で、
シートに戻り、Ａ列にデータを入れると
例
Ａ３　日東紙工
Ａ４　佐野産業
と入れると、
名前ボックスに
日東紙工
佐野産業
が現れる（名前が登録される）。
上記はMsgbox　行は削除や変更してください。
普通のＶＢＡの標準モジュールと違うところに、コードを書く必要がある点、
初心者には判りにくい。
ーー
http://officetanaka.net/excel/vba/tips/tips118.htm
あるセルがセル範囲に含まれるかどうか
こういう知識も必要。
ーー
Is Nothing Thenなどは、
Ｇｏｏｇｌｅで「ＶＢＡ　Ｉｎｔｅｒｓｅｃｔ」で照会して、ＷＥＢ記事で勉強。
上記のRange("A2:A50"))は適宜設定のこと。

補足

早々のご回答ありがとうございます。
早々に確認したのですが、
「名前が適切ではありません：Worksheet_Change」と出ます。
当方初心者のビギナーですので修正箇所も分からずお手上げ状態です。
とほほ・・・・

回答No.1

SI299792

Ａ列と書いてありますが、図ではＢ列になっています。Ｂ列にしました。
どっちがわからないので、２種類用意しました。

全部入れてから一度に名前を定義するの場合
標準モジュール
'
Option Explicit
'
Sub Macro1()
'
　　Dim Row As Long
　　Dim SName As String
'
　　For Row = 5 To Cells(Rows.Count, "B").End(xlUp).Row
　　　　SName = Cells(Row, "B")
　　　　On Error Resume Next
　　　　ActiveWorkbook.Names(SName).Delete
　　　　On Error GoTo 0
　　　　ActiveWorkbook.Names.Add SName, "=$D$" & Row & ":$R$" & Row
　　Next Row
End Sub

Ｂ列を入れる度に名前を定義する場合
シートモジュール
'
Private Sub Worksheet_Change(ByVal Target As Range)
'
　　If Target.Count > 2 Or Target.Column <> 2 Or Target.Row < 5 Then
　　　　Exit Sub
　　End If
'
　　On Error Resume Next
　　ActiveWorkbook.Names(Target).Delete
　　On Error GoTo 0
　　ActiveWorkbook.Names.Add Target, "=$D$" & Target.Row & ":$R$" & Target.Row
End Sub

補足

早々のご回答ありがとうございます。
試してみたのですが見たのですが、有るシートではうまく動いたのですが、別のBookのシートでは全く同じようにコードをコピペしたはずなのにマクロを実行しようとF5を押してもマクロの窓に何も出て来ないので、マクロが登録されていないように見えます。

どこが悪いのか全く分かりません。