『Excelでサイジェスト』（たか） 過去の内容を拝見して同じようにやってみたのですが、私の条件ではうまくいかず、動作しなかったので質問させていただきます。 入力シートのN10からN16の結合セル4つを対象に品名を入力するようになっています。 ここに入力するとき「品名リスト」の別シートのA3から下に入力してある品名を参照して、入力支援してくれるようにしたいのですが、リストにない場合は普通に入力されたものになるようにしたいと思ってます。 初心者のため分からないことが多いですがアドバイス等よろしくお願いします。 ＜ 使用 Excel：Excel2013、使用 OS：Windows8 ＞ ---- こちらを参考にしてみては？ 「例外データの入力も認める入力規則」 http://pc.nikkeibp.co.jp/article/technique/20090708/1016800/?rt=nocnt （γ） 2015/05/17(日) 17:36 ---- コメントありがとうございます。 過去ログではリスト以外は入力しないという定だったためあえて書きましたが、通常のリスト表示・入力規制の方法は知っていました。 しかし品名のリストは100以上と多いためVBEでの方法を考えていて質問させていただきました。 （たか） 2015/05/17(日) 17:54 ---- えーと、ここの掲示板はマクロも一般機能の質問も両方ありますから、 されたいことをもっとハッキリ書いてもらうとありがたい。 それで、 どこまでご自分でトライして、現在、何に詰まっているのか教えてください。 入力規則はもう設定されているのですか、それともこれから？ マクロ記録とかとってみたのですかね。 コードが部分的にもあるならそれを提示して欲しいです。 # ちなみに、"サイジェスト"って何ですか？ 何かの流行ですか？ # generation gapみたいです。 （γ） 2015/05/17(日) 18:18 ---- 私も、最近のトレンドにうといものですので、サイジェストは初耳でしたが http://www.sophia-it.com/content/Google%E3%82%B5%E3%82%B8%E3%82%A7%E3%82%B9%E3%83%88 http://www.nttpc.co.jp/yougo/%E3%82%B5%E3%82%B8%E3%82%A7%E3%82%B9%E3%83%88%E6%A9%9F%E8%83%BD.html オートコンプリートの進化版のようですね。 ところで >>入力シートのN10からN16の結合セル4つ N10からN16 までにはセルが 7個あるわけですが、どことどこが結合されて 4つになっているのですか？ （β） 2015/05/17(日) 18:29 ---- ありがとうございます。サジェストでしたか。 入力規則が求めているものではないようなので、 2015/05/17(日) 18:18 の　私の回答はリセットしてください。 色々な方法があるんでしょうね。 ・シート上のActiveXコントロール（コンボボックス？） ・ユーザーフォームの利用（コンボボックス？リストボックス？） ・（入力規則） しかし、何をもってサジェスト機能とされているのか私にはわからないので、 いったん降りますね。 （γ） 2015/05/17(日) 18:59 ---- すみません。入力セルはN17までの間違いでN16は結合セルの値でした。 二つずつの結合で4つのセルになります。 試したマクロは過去ログから Private Sub Worksheet_Change(ByVal target As Range) 'DicSheetNameは辞書のシート名、 'DicRangeAddressは辞書の範囲を指定する ' Const DicSheetName = "品名リスト" Const DicRangeAddress = "A" '※入力セル以外の変更は無視 If Intersect(target, Range("N10:N16")) Is Nothing Then Exit Sub If target.Count > 1 Then '選択セルが２つ以上は無効 MsgBox "複数セル同時変更はサポートしません" & vbLf & "入力を取消し元に戻します" Application.EnableEvents = False Application.Undo Application.EnableEvents = True Exit Sub End If Application.EnableEvents = False If Not 入力候補表示(DicSheetName, DicRangeAddress, target) Then MsgBox "リストにない値の入力は無効です" & vbLf & "入力を取消し元に戻します" Application.Undo End If Application.EnableEvents = True End Sub (標準モジュール） Function 入力候補表示(Sh As String, Rg As String, Tg As Range) As Boolean Dim c As Range Dim v() As String Dim k As Long If Len(Tg.Value) = 0 Then 'クリア Tg.Validation.Delete 入力候補表示 = True 'OK Exit Function End If With Sheets(Sh) With .Range(Rg & "1", .Range(Rg & .Rows.Count).End(xlUp)) ReDim v(1 To .Count) For Each c In .Cells If c.Value Like Tg.Value & "*" Then k = k + 1 v(k) = c.Value End If Next End With End With If k = 0 Then Exit Function 'NG If k = 1 Then Tg.Validation.Delete Tg.Value = v(1) Else '入力規則のセット With Tg.Validation '入力規則を設定 .Delete .Add Type:=xlValidateList, Formula1:=Join(v, ",") .ShowError = False .InCellDropdown = True End With Tg.Select SendKeys "%{DOWN}" End If 入力候補表示 = True 'OK End Function これで途中までの文字入力、　ctrl+enterで品名リストにある品名がリストで選択できるということですが、 このコードだと結合セルだとメッセージが出てキャンセルされるようになっており、リストにないものも入力できない仕様になってあります。 この部分のコードを消したりしてやってみたのですがエラーになったりでうまく動作しない状態です。 （たか） 2015/05/17(日) 19:25 ---- 回答者への参考として。 http://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q14145640209 （マルチネス） 2015/05/17(日) 20:05 ---- コード自体は、ネットで紹介されている標準的なものをベースにしているようですね。 こちらで、このままやってみましたが結合セルだからエラーということはなく、ちゃんと動きますよ。 ところで、品名は半角英数字ですか、全角文字ですか？　全角文字なら入力途中での Ctrl/Enter ではなく Enter でしょうから。 で、全角文字で　Ctr/Enter でも何も変化しないので、もう一度、Ctrl/Enter。そうするとマクロ内での 複数セル入力禁止チェックにかかりますね。 結構、セル上での全角文字入力でのこの制御は、面倒ですね。 それはともあれ、このコードでは　.ShowError = False　で、リスト以外の文字列も受け入れてはいるんですが その前に、対象のものをピックアップした結果が　0 の場合、プロシジャを抜けてしまって、戻り値が False. なので、抜けてきた後、エラー判定されてしまってますねぇ。 回避する案、いくつか思いつくんですが、↑でふれたように、セル上での入力による制御は面倒かもしれません。 １文字ごとにChangeイベントが発生する ActiveX　を利用したほうがいいかも。 少し考えてみます。 その間に、あちらのほうで、さらっと解決策がでればうれしいですね。 （β） 2015/05/17(日) 20:08 ---- とりええず、 If k = 0 Then Exit Function 'NG If k = 1 Then Tg.Validation.Delete Tg.Value = v(1) ここを If k = 0 Then Tg.Validation.Delete ElseIf k = 1 Then Tg.Validation.Delete Tg.Value = v(1) こうかえてみてください。 なお、全角入力の場合、入力途中で　Ctrl/Enter ではなく　Enter して　もう一度 Enter でリストが出るようですよ。 （β） 2015/05/17(日) 20:25 ---- 結合セルでダメかと思ったら、全角入力でctrl/enterを押してたためだったんですね。 品名は基本英数字のみなので、セルに半角入力で強制するようにした方がいいかもですね。 変更していただいたコードで特に問題なく動作できているようです。 ただ、やはりリストにないと一部強制的に品名が選ばれてしまうようですね。 たとえばABCDEFという品名が登録されていたとして、登録されてないABCDEを入力しようとすると強制的にABCDEFになってしまいますね。 やはりちょっと変更が必要なのかな？ あと、大文字と小文字を区別なく入力して、リストの品名を呼び出せるようにするにはどうしたらいいでしょうか？ 小文字入力でも大文字品名が出てくるようにしたいのですが。 （たか） 2015/05/18(月) 00:03 ---- >>大文字と小文字を区別なく入力 If c.Value Like Tg.Value & "*" Then これを If StrConv(UCase(c.Value), vbNarrow) Like StrConv(UCase(Tg.Value), vbNarrow) & "*" Then とか。 >>ただ、やはりリストにないと一部強制的に品名が選ばれてしまうようですね こちらではリストにない項目は入力できていますけど？ ところで、アップされたような入力規則での制御もあるわけですが、γさんが示唆された　ActiveXコントロールを使って制御する方法もあるかと。 （β） 2015/05/18(月) 05:48 ---- 参考出品です。 このブックに、新規シートを追加し、N10〜N17 を２セルずつ結合。 で、ActiveXのTextBox1 と ListBox1 を適当な場所に挿入。ListBox1はサジェストリストになりますので大きさは好みのものに。 そのうえでシートモジュールに以下。 まず、N10〜N17 以外を選択してください。TextBox1　と ListBox1 が非表示になります。 これで準備完了。 半角英数字であれば、タイプするごとに（Enterなしで）サジェストリストが変化していくと思います。 もちろんリスト以外の入力も可能です。 次のセル、あるいは、全く別のセルに入力する場合は、マウスで、そのセルを選択してください。 Option Explicit Dim pos As Range Private Sub ListBox1_Click() If pos Is Nothing Then Exit Sub TextBox1.Value = ListBox1.Value End Sub Private Sub TextBox1_Change() pos.Value = TextBox1.Value TextBox1.Activate End Sub Private Sub Worksheet_Change(ByVal target As Range) Dim c As Range Dim w As Variant Dim v As Variant Dim x As Variant If pos Is Nothing Then Exit Sub If IsEmpty(target) Then Exit Sub v = Sheets("品名リスト").Range("A1", Sheets("品名リスト").Range("A" & Rows.Count).End(xlUp)).Value If IsEmpty(target) Then ListBox1.Column() = v Else ListBox1.Clear ListBox1.ListIndex = -1 With Sheets("品名リスト") For Each x In v If StrConv(UCase(x), vbNarrow) Like StrConv(UCase(target.Value), vbNarrow) & "*" Then If IsArray(w) Then ReDim Preserve w(1 To UBound(w) + 1) Else ReDim w(1 To 1) End If w(UBound(w)) = x End If Next End With If IsArray(w) Then ListBox1.List = w ListBox1.Left = target.Left ListBox1.Top = target.Top + target.MergeArea.Height Application.EnableEvents = False target.Select Application.EnableEvents = True End If End If End Sub Private Sub Worksheet_SelectionChange(ByVal target As Range) If Intersect(target(1), Range("N10,N12,N14,N16")) Is Nothing Then Set pos = Nothing ListBox1.Visible = False TextBox1.Visible = False Else ListBox1.List = Sheets("品名リスト").Range("A1", Sheets("品名リスト").Range("A" & Rows.Count).End(xlUp)).Value Set pos = target(1) TextBox1.Value = target(1).Value ListBox1.Left = target(1).Left ListBox1.Top = target.Top + target(1).MergeArea.Height TextBox1.Top = target(1).Top TextBox1.Left = target(1).MergeArea.Left TextBox1.Height = target(1).MergeArea.Height TextBox1.Width = target(1).Width ListBox1.Visible = True TextBox1.Visible = True TextBox1.Activate End If End Sub （β） 2015/05/18(月) 06:03 ---- どうもです。βさん、言及ありがとうございます。 (1) > 登録されてないABCDEを入力しようとすると強制的にABCDEFになってしまいますね。 これは、マッチした文字列がひとつのときは、そのまま採用してしまう、 つまり、↓の部分 ElseIf k = 1 Then Tg.Validation.Delete Tg.Value = v(1) とのトレードオフですね。 (2)大文字小文字の話 StrConvで対応する以外にこんな方法があると思います。 モジュールの先頭に Option Compare Text としておくと、大文字小文字や、全角半角を同一視してくれるんじゃないでしょうか。 (3) 現コードは、文字列を入力してから、それに見合う候補を入力規則に設定する方式ですが、 βさんが提案くださった、文字入力ごとに反応していく、 いわゆる　インクリメンタルサーチ もあるかもしれませんね。 私にはこの言葉のほうがなじみがあるし、しっくり来ます。 # google サジェスト機能は、インクリメンタルだし、 # 機械的なマッチ以上のものがあるんじゃないかな。 # ところで、 # 最初の質問文だけでは、質問の意図を読み切れないのは致し方なかったと思う。 # あれだけで、想像できるわけがない。 # 説明をもっと求めるのが正しい対応だったと反省される。 （γ） 2015/05/18(月) 06:51 ---- >>トレードオフですね。 絞り込み対象が１つだった時、選択の必要がないということで、v(1) から強制的にセットした上で 入力規則を解除しているんだと思われますが、リストにないものをいれてエンターしますと 絞り込み 0 件になって k = 0 。で、そのまま受け入れられてセルに残るというのが、こちらでの状況です。 操作手順によって、そうならないケースがあるのかもしれませんね。 いずれにしても、このセルイベントを利用する方式だと、文字タイプのみでは認識されず、たとえば A とタイプして確定のためにEnter。 で、続けて AB としたい場合、フォーカスがリストに行ってますので、もう一度セルを選び、 A を AB にしてEnter。 使いづらいなぁと思いました。 で、γさんご示唆のActiveXでどうかなと、試してみたんですが、日頃、「Changeイベントは１文字ごとに発生するので使い物にならない」 こう思っていましたけど、逆に１文字ごとに発生するのでEnterなしでも処理可能。 おぉ、なかなかいいじゃないかと、Changeイベントを見直した次第です。 >>Option Compare Text そうですね！　少なくとも本件では、このモジュール全体で、この設定に不都合はありませんので。 ただ、この先、このモジュール内で、別の比較ロジックを追加していった場合、Option Compare Text の記述のことを 忘れてしまって悩む場面もあるかも・・ということで、まだるっこしいのですが、これを使いました。 >>あれだけで、想像できるわけがない。 γさんの疑問投げかけでコードが登場し、あぁ、こんなことなのかとわかりましたので、助かりました。 ただ、もしかしたら・・・コードでは入力規則で処理しているわけですけど、質問者さんは、それに気が付いていなかったのかも。 （β） 2015/05/18(月) 07:47 ---- 説明不足、理解不足で申し訳ありませんでした。 小文字でも動作するようになり求めていたものとなりました。 上記一部の問題を考えるとやはりactiveXの方が完成度が高いですね。まだまだ理解出来ないことばかりですがこんなことも出来るんですね。 ちなみに、activeXの方で入力セルを選択すると入力状態ですぐリストが下に出ますが、例えば一文字入力してからリストが出るようなことは可能ですか？ 通常通り矢印を選択したらリストが出るような感じの方がいいのかなとちょっと思ったもので。 （たか） 2015/05/18(月) 20:37 ---- お望みの形かどうか自信ありませんが、 ・ListBox1 と TextBox1 を廃止。 ・かわりに ComboBox1 を挿入。 ・ComboBox1 のプロパティで　MatchEntry を　2-fmMAtchEntryNone にしておいてください。 で、シートモジュールを入れ替え。 Dim pos As Range Private Sub ComboBox1_Change() pos.Value = ComboBox1.Value ComboBox1.DropDown ComboBox1.Activate End Sub Private Sub Worksheet_Change(ByVal target As Range) Dim c As Range Dim w As Variant Dim v As Variant Dim x As Variant If pos Is Nothing Then Exit Sub If IsEmpty(target) Then Exit Sub v = Sheets("品名リスト").Range("A1", Sheets("品名リスト").Range("A" & Rows.Count).End(xlUp)).Value If IsEmpty(target) Then ComboBox1.Column() = v Else With Sheets("品名リスト") For Each x In v If StrConv(UCase(x), vbNarrow) Like StrConv(UCase(target.Value), vbNarrow) & "*" Then If IsArray(w) Then ReDim Preserve w(1 To UBound(w) + 1) Else ReDim w(1 To 1) End If w(UBound(w)) = x End If Next End With If IsArray(w) Then ComboBox1.List = w ComboBox1.Top = target(1).Top ComboBox1.Left = target(1).Left ComboBox1.Height = target(1).MergeArea.Height ComboBox1.Width = target(1).Width Application.EnableEvents = False target.Select Application.EnableEvents = True End If End If End Sub Private Sub Worksheet_SelectionChange(ByVal target As Range) If Intersect(target(1), Range("N10,N12,N14,N16")) Is Nothing Then Set pos = Nothing ComboBox1.Visible = False Else ComboBox1.List = Sheets("品名リスト").Range("A1", Sheets("品名リスト").Range("A" & Rows.Count).End(xlUp)).Value Set pos = target(1) ComboBox1.Value = target(1).Value ComboBox1.Top = target(1).Top ComboBox1.Left = target(1).Left ComboBox1.Height = target(1).MergeArea.Height ComboBox1.Width = target(1).Width ComboBox1.Visible = True ComboBox1.Activate End If End Sub （β） 2015/05/18(月) 21:29 ---- βさんの ActiveX利用の手法は なかなか良いですね。 勉強になります。（直近の発言はまだ読んでいない状態です） # 私は昔、AdvancedFilterとChangeイベントの組み合わせで似たような仕組みを # 作ったことがあります。 ところで、 > > 登録されてないABCDEを入力しようとすると強制的にABCDEFになってしまいますね。 > これは、マッチした文字列がひとつのときは、そのまま採用してしまう、 > つまり、↓の部分 > ElseIf k = 1 Then > Tg.Validation.Delete > Tg.Value = v(1) > とのトレードオフですね。 のところは、こういう積もりだったのです。 ABCDEを入力 して Enter →ABCDE* で 品名を検索に行く。 →ABCDEF だけがマッチ → k = 1 なので、自動でセルに ABCDEF が 書き込まれる ということで、ABCDE だけをセルに設定することができない、という話でしょう。 これは、ABCDEFまで入れなくても、唯一のマッチを確定できるというメリットと、 トレードオフの関係にあるのかもしれない、という積もりでした。 でも、βさん案を改良？したほうがいいように感じます。 質問者さん、頑張ってください。 （γ） 2015/05/18(月) 21:39 ---- コンボボックスの方がいい感じに使えそうですね。 ただ新たな問題として文字数が多いとセル内に収まらず、コンボボックス・リストボックスの仕様上これを改善するのは難しいでしょうか？ （たか） 2015/05/19(火) 01:52 ---- コンボボックス等の仕様というより、別の課題ですけど、ちょっと後回しにして。 仮に、セル幅より長い名前があったとします。で、そういうものに、コンボボックス等の幅を自動であわせて広げたとします。 でも、最終的にはセルに記入されるわけで、そこで、セルに収まりきらないですね。 （N列が2行結合ということですけど、ここを「折り返して全体を表示」と設定してあるなら、２行分はおさまりますが） 収まらなければ、O列が空白なら、そこにまたがって表示されますが、O列に値があれば、収まりませんよね。 たとえば、リストの元ネタ、品名リストのA列ですけど、そこでは、収まっているのですか？ もし、収まっているなら、N列の幅を品名リストのA列と同じにしておけばよろしいと思いますが？ コンボボックス等の幅は、コード内で、N列の幅にあわせるようにしていますので。 品名リストには、セル幅に収まるようなものだけが登録されているけど、それ以外の任意の品名を入力した時に それが長くて、収まりきらないということでしょうか？ それも、同じで、コンボボックス等で細工をしても、セルに入れば、収まりきらないわけですよね？ 文字数をカバーする長さは、エクセルでは（なぜか）すんなりとは取得できません。 ですから、それにあわせて、ぐ〜んと自動的に幅を広げるというのは、やっかいです。 ただ小細工はできます。これが必須要件であれば、そういう小細工をすることも考えられますが その前に、上で述べたようなことを検討してみてください。 ●それとは別に、品名リストは A3 からだったんですね。アップしたコードでは A1 からにしていました。 　コード内に２か所ある A1 を A3 に変更してください。 To γさん >>βさんの ActiveX利用の手法は なかなか良いですね。 勉強になります。 大師匠のγさんに言われると、汗、汗で緊張します。 コード自体は、結構、急いで書いたところもありますし、この時は、このイベントが発生するはずだから そちらで、こうやって、もどってこうやってと、書きながら、（推敲不十分のまま）ながれで記述していますので じっくり見ると、無駄なところもありそうですし、操作の手順によっては不具合が発生するところもあるかもしれません。 気が付かれたことがあれば、ご指摘いただければ幸甚です。 （β） 2015/05/19(火) 07:01 ---- >># 私は昔、AdvancedFilterとChangeイベントの組み合わせで似たような仕組みを >># 作ったことがあります。 フィルターオプションもいい方法ですよね。 つい最近（γさんも、コメント寄せられていましたが）別の板で、オートフィルターで処理したものを提案したことがあります。 今回は、アップされたオリジナルコードで Like 比較をしていたので、なんとなく、それを継承。 おそらく、抽出の効率はフィルターオプション（今は、死語？）が最も優れているのでしょうね。 （β） 2015/05/19(火) 07:11 ---- >>コンボボックス・リストボックスの仕様上 あっ！　もしかして、基本的にはセル幅に収まるんだけど、コンボボックス等では、先頭に、１文字分ぐらいの すきまができて、その分、（コンボボックス等の上の表示では）おさまらないということでしょうか？ （コンボボックスの場合、最後の▼も１文字分ぐらい占有してますね） それであれば、その幅を、セル幅 + ちょっと　にしておけばよろしいと思います。 （β） 2015/05/19(火) 07:23 ---- すみません。セルの設定で改行するが出来てませんでした。 全部の品名で確認は出来てないですが、概ね入りそうな感じですね。 ただ品名の切りが悪い所で改行されると見ずらいので、リストの方で細工をするか入力時に調整が必要そうですね。 品名入力は日報の一部のため、セルサイズは決まっており変更は難しいのでリストの方で調整をやってみたいと思います。 （たか） 2015/05/19(火) 18:35 ---- 外出していて、レス遅れました。 （β） 2015/05/19(火) 07:01 と（β） 2015/05/19(火) 07:23　で、セルに入りきらないということは、 具体的にはどのようなことをいってますかと質問しているんですが、その回答をお待ちします。 加えて、そちらで試したら、こういうときに、こうなってしまう。これを、このようにできないかということを 具体的な例で示していただけませんか。 あと、 >>変更は難しいのでリストの方で調整をやってみたいと思います。 この意味は、(たか)さんが、調整されるということですね？ そうではなくβに調整させたいということであれば、「リストのほう」というのが何を意味しているのかを教えてください。 （β） 2015/05/19(火) 22:06 ---- 最初セルの設定で折り返しになっていなかったので、一行分の表示だけで入り切らなかったということです。 リストの方は品名が横一列にすべて表示されるように広く設定してあります。 もし入力側の2列で収まらない文字数があれば見えない部分が発生するかもしれませんね。 リストの方の調整は私の方でという意味です。 品名の一部でスペース調整して折り返し位置を合わしたり、文字数が多い場合はフォントサイズを小さめに設定してみるとかですかね。 （たか） 2015/05/20(水) 00:59 ---- 了解です。 （β） 2015/05/20(水) 05:08 ---- 最終的に、どのコントロールで処理されるかは、ご自身で判断されるとして、コード中のコントロールの位置につき .Left = ●●● .Width = ■■■ となっているところを .Left = ●●● - 6.48 .Width = ■■■ + 6.48 * 3 ぐらいにすれば、（もしかしたら）イメージにあうかもしれません。 （β） 2015/05/20(水) 09:39 ---- 返事遅くなりすみません。 コンボボックスの設定で行こうと思ってますが、今考えてるのは品名をA列とB列に分けてリストに表示し、 尚且つ両方入力できないかと考えてます。 コンボボックスの仕様上は出来ないようですが何かいい方法はないでしょうか？ 入力セルが結合セルですが2行分なので上にA列、下にB列が表示するように、間に改行またはスペース調整で入力出来るのが理想かなと思っています。 .ColumnCount = 2でリスト表示するまでは分かったのですが、やはり値としてはどちらかしか入力できないですよね？ （たか） 2015/05/23(土) 16:19 ---- そうですねぇ。 たとえば　コシヒカリ　魚沼産棚田米　とか　コシヒカリ　小国産棚田米　といった長い名前のものを 　　A列　　　　　B列 　コシヒカリ　魚沼産棚田米　 　コシヒカリ　小国産棚田米 こんな感じですかね。 トライされたように、これを２列データとしてコンボボックスに表示させるのは可能ですが、あくまで入力し抽出させるトリガーとしては いずれか１つの列。 ただ選んだ結果を、２行連結されたセルに　その内容を　「１つの文字列」の　「コシヒカリ　魚沼産棚田米」として、かつ表示は コシヒカリ 魚沼産棚田米 とセル内改行の形で表示させることはテクニックとしては可能だと思います。 ただ、この方式をとるなら、すべての商品をそういう扱いにし、セル内上段の文字列でのみ A列を検索することになります。 それが、運用としてどうか、ちょっと、イメージがわかないところもありますが、ちょっと書いてみましょうか。 (でも、使い物にならないということになるかもしれませんがね） （β） 2015/05/23(土) 17:09 ---- ↑ >>ちょっと書いてみましょうか ということで、ちょこっと書いて動きをみてみましたが、あまり使いやすそうでもないです。 別の方法を考える必要がありますねぇ。 （β） 2015/05/23(土) 17:42 ---- 思い付きですが。 ・商品登録のリストそのものを　長いものはセル内改行で（適切な位置で改行）登録しておく。（あくまで商品文字列は１つ） ・コンボボックスの幅はマクロ内で現在の２倍ほどにする。 そうすると、 コシヒカリ 魚沼産棚田米 とセル内改行で登録されている商品は、コシヒカリ$魚沼産棚田米　（$は実際には改行コード文字） としてコンボボックスのリストにひょうじされ、最終的に選ばれれば、当該セルには コシヒカリ 魚沼産棚田米 と、セル内改行で表示される。 この形であれば、現行のコード、ほとんど、そのまま、コンボボックスの幅をなおすぐらいでいけますけど いかがですか？ （β） 2015/05/23(土) 18:18 ---- ↑　と、思ってちょこちょこっとやってみたけど、苦戦中。だめかも。 （β） 2015/05/23(土) 18:39 ---- わざわざ検証ありがとうございました。 品名というのは具体的にいいますと、品名ごとにサイズの種類がありまして、 品名＋サイズ(数字)というのを必ず入力するようになってます。 そのため入力セルの上側に品名部分、下にサイズと表示されると見栄えも見やすくなるため そのように入力出来たらと考えた次第です。 またA列にサイズも組み込めば問題ないことですが、リストとなる元データが品名とサイズ部分が分かれていたのと、サイズ部分のデータを全く別のところでちょっと利用したいなぁと思ったため2列入力が出来ないかなと思いました。 別の方法となるとコード的には全くわかりませんが、リストに入力用のセル(列)を作っといて、リスト選択時にはその列は表示されていないが、入力値は入力用の列の値が入力されるみたいなことでしょうか？ （たか） 2015/05/23(土) 18:49 ---- 苦戦はかわりませんが、少し光が見えてきたところです。 ところで、以前、製品名そのものが長いので折り返して２行表示　といった話題がありましたが 仮に、サイズがあるものについてなんらかの対応をしたとして、製品名そのものの長さがどうこうということは 忘れていいですね？ いやいや、両方ということであれば、ロジック的なこともありますが、ＵＩとして、今の構えでは無理っぽいので。 どうしても、両方の場合は、(たか)さんのほうで、こういう持ち方で、こういうレイアウトにするので、このように表示して セルには、これこれのように転記したいと、具体的なイメージを作り上げて投げかけてもらう必要があります。 さて、サイズを持つ製品についてはサイズ列も処理に取り入れたとして 製品A Size1 製品A Size2 製品B 製品C SizeA 製品D こんな２列があったとして、 まず N列に書きこむ対象は　製品名だけですか？　それとも　サイズも含めた２行表示ですか？ サイズも含めた２行表示の場合、あくまで文字列としては１つですから、Ｎ列に書きこまれているものが 逆にいえば製品名ではないということになりますが。 あるいは、N列の行結合をやめ、N10が製品名、N11がサイズ　というような扱いもできますが？ それと、コンボボックスのリストとしては 製品A●Size1 製品A●Size2 製品B 製品C●SizeA 製品D と、製品名とサイズの間に、何か区切りコードを（マクロ内で）いれて扱うことになると思っています。 この区切りコードは、半角スペースなんかが扱いやすいのですが、もし、製品名やサイズそのものに 半角スペースがあるなら、どこが区切りかわからなくなりますので、文字列では使われない特殊文字を 使う必要がでてきます。 もちろん、ふつうに、コンボボックスを２列にすることもできます。 ただ、その場合、あくまで、コンボボックス内は製品名だけで、サジェスト機能も製品名だけの範囲になります。 （ドロップダウンしたコンボボックスのリストは２列表示ですが） これでよければ、そのほうがコード的には素直です。 で、N列には、その製品名だけが入るんですが、行結合をやめれば N10に製品名、N11にサイズということもできます。 （無理やり、製品名●サイズ　として転記することもできますが、↑でふれたように、N列の値が製品名ではなくなるということと 　区切り文字を何にしようかという課題は残ります） そのあたりはいかがですか？ あと、もう１つ教えてください。 コンボボックスで選択しN列のセルに書きこんだ後、操作者が次に入力するセルは N列の１つ下の結合セルですか？　それとも、今書きこんだ行の右のセル（O列)ですか？ コンボボックスの幅を長くする必要があると思っていて、その場合、O列が、コンボボックスにおおわれてしまうので コンボボックスでの選択後、O列をマウスで選択することができなくなり、一度、別のセルをクリックして コンボボックスを非表示にするというのが、やってみると面倒だなぁと感じましたので。 コンボボックスで選択されたら自動的に「次のセル」にフォーカスを移し、コンボボックスを非表示にしようと思っています。 その「次のセル」を、下にしたらいいのか、右にしたらいいのか、それは、そちらの入力順として どちらがいいのかによりますので。 （β） 2015/05/24(日) 05:58 ---- 以前品名が長いと言ったのはそのサイズも入れるため1行では収まらないって意味で書きました。 N列入力の製品名というのは品名＋サイズというのが必ず入ります。逆にサイズが付かないものは一つもないと考えてもらったらいいです。サイズも含めたものが製品名となります。 そのためサイズも含めたサジェスト機能の方がいいのでコンボボックスは分けない方がいいですね。 スペースに関してはまだ品名やサイズ部分に入れたりは行っていません。 最終的には選択入力後、各自で品名の後ろにスペース入れて調整してもらってもいいのかなと思ってます。 次の入力セルですが、右横になります。実際にはNのセルは横にも小さいセルが幾つも結合されてるので、Oではないですが今確認出来ないので、Oにしといてください。その辺はこちらで修正します。 （たか） 2015/05/24(日) 07:20 ---- アップ済みのコードもそうでしたが、イベントの連鎖を抑止したり、あるいは連鎖を利用したりと、なんだか あぶなっかしい綱渡りのような流れなので、自信度 50%ぐらい。 A列に品名、B列にサイズ。コンボボックス上は　品名□サイズ（□は半角スペース） で、選択されてN列に転記されると、品名□●サイズ　になるのでこのセルの値の扱いには注意願います。（●は改行コード） コンボボックスの幅を２倍にしたので、次の列のセルを選択できないことから、面倒かもしれないけど 選択終了（あるいは直接入力終了）したら、コンボボックスをダブルクリックしてください。 やってみて、具合悪ければ指摘願います。 Option Explicit Dim pos As Range Dim first As Boolean Private Sub Worksheet_SelectionChange(ByVal target As Range) If Intersect(target(1), Range("N10,N12,N14,N16")) Is Nothing Then Set pos = Nothing ComboBox1.Visible = False Else first = True If IsEmpty(target(1)) Then Set pos = target(1) ComboSet Else Set pos = Nothing ComboBox1.Clear ComboBox1.Value = Empty Set pos = target(1) ComboBox1.Value = valueConv(target(1).Value, True) End If first = False PlaceCombo target ComboBox1.Visible = True ComboBox1.Activate End If End Sub Private Sub ComboBox1_Change() ComboSet End Sub Private Sub ComboBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean) If pos Is Nothing Then Exit Sub pos.Value = valueConv(ComboBox1.Value, False) pos.Offset(, 1).Select End Sub Private Sub ComboSet() Dim w As Variant Dim sv As String Dim tmp As Range If pos Is Nothing Then Exit Sub sv = ComboBox1.Value w = getList(ComboBox1.Value) ComboBox1.Clear If IsArray(w) Then If UBound(w, 1) = 1 Then ComboBox1.AddItem w(1) Else ComboBox1.List = w End If End If Set tmp = pos Set pos = Nothing ComboBox1.Value = sv Set pos = tmp If Not first Then ComboBox1.DropDown ComboBox1.Activate End Sub Private Function getList(myStr As String) As Variant Dim c As Range Dim w1 As Variant Dim w2 As Variant Dim w As Variant Dim i As Long Dim v As Variant Dim x As Variant Dim s As String With Sheets("品名リスト") With .Range("A1", .Range("A" & .Rows.Count).End(xlUp)) w1 = .Value 'A列 w2 = .Offset(, 1).Value 'B列 End With End With For i = 1 To UBound(w1, 1) s = w1(i, 1) & " " & w2(i, 1) If StrConv(UCase(s), vbNarrow) Like StrConv(UCase(myStr), vbNarrow) & "*" Then If IsArray(w) Then ReDim Preserve w(1 To UBound(w) + 1) Else ReDim w(1 To 1) End If w(UBound(w)) = s End If Next getList = w End Function Private Sub PlaceCombo(target As Range) ComboBox1.Top = target(1).Top ComboBox1.Left = target(1).Left - 6.48 ComboBox1.Height = target(1).MergeArea.Height ComboBox1.Width = target(1).Width * 2 + 6.48 * 3 End Sub Private Function valueConv(myStr As String, inbound As Boolean) As String If inbound Then 'Cell to Combo valueConv = Replace(myStr, vbLf, "") Else 'Combo to Cell valueConv = Replace(myStr, " ", " " & vbLf) End If End Function （β） 2015/05/24(日) 16:25 ---- 留意事項を。 ↑のコードでは、コンボボックスで選ぶないしは入力した値がセルに転記されるのはコンボボックスをダブルクリックした時だけです。 ダブルクリックせずに、他のセルを選ぶと、コンボボックスは非表示になりますが、セルには書きこまれません。 最終選択はしない、キャンセル　といったことを考えてそうしてありますが、選んだもの（入力したもの）は ダブルクリックしなくても、別のセルを選んだら、もとセルに反映させたいということなら、そのように対応します。 （β） 2015/05/24(日) 16:59 ---- すべてワークシートのコードに入力でいいですかね？ 試してみたのですがオブジェクトが必要ですとエラーになってしまいます。 場所はセルをクリックする場所によって多少変わりますが、Worksheet_SelectionChangeのComboBox1.Visibl = False　や　Private Sub ComboSet()の　If pos Is Nothing Then Exit Subが黄色くなります。 （たか） 2015/05/24(日) 17:25 ---- Worksheet_SelectionChangeの方はコンボボックスが設置出来ていなかったためで、出なくなりましたが ＮセルをクリックするとIf pos Is Nothing Then Exit Subが黄色くなり、オブジェクトが必要といわれてしまいます。 そこにマウスを持っていくとpos=empty値と出ています。 （たか） 2015/05/24(日) 18:01 ---- ん？ シートモジュールの先頭に Option Explicit Dim pos As Range Dim first As Boolean この記述があってもエラーになるんですか？？？？ （β） 2015/05/24(日) 18:15 ---- 指摘のエラーとは関係ない部分ですが、N列を選択した時に、コンボボックスに、それ以前に入っていた値が 消えずに表示されるケースがあります。 後ほど、そこは訂正してアップします。 （β） 2015/05/24(日) 18:22 ---- すみません。他のコードもあり先頭に記述出来ていなかったのが原因でした。 無事動作できました。 表示も理想の感じでうまく改行されて表示されるのでいい感じですね。 ただやはりダブルクリックだとちょっと面倒な感じもしますね。リストの品名を選択してからダブルクリックしないといけないみたいで、削除するときもすべて選択してdelete、そしてダブルクリックが必要ですよね？ また二行目のセルに入力するときはご指摘の通り、空白ではなく前のデータから表示されてしまうようですね。 もうちょっといろいろ試してみますね。 （たか） 2015/05/24(日) 19:02 ---- それでは、ダブルクリックしなくても、別のセルを選べば、その時の値がセルに書きこまれるように変更。 あわせて、ケースによっては、前のコンボボックスの値が残ってしまっている点を修正。 SelectionChange を以下で置き換えてください。 Private Sub Worksheet_SelectionChange(ByVal target As Range) If Not pos Is Nothing Then pos.Value = valueConv(ComboBox1.Value, False) If Intersect(target(1), Range("N10,N12,N14,N16")) Is Nothing Then Set pos = Nothing ComboBox1.Visible = False Else first = True If IsEmpty(target(1)) Then Set pos = Nothing ComboBox1.Value = Empty Set pos = target(1) ComboSet Else Set pos = Nothing ComboBox1.Clear ComboBox1.Value = Empty Set pos = target(1) ComboBox1.Value = valueConv(target(1).Value, True) End If first = False PlaceCombo target ComboBox1.Visible = True ComboBox1.Activate End If End Sub なお、ダブルクリックは不要ということなら、 Private Sub ComboBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean) If pos Is Nothing Then Exit Sub pos.Value = valueConv(ComboBox1.Value, False) pos.Offset(, 1).Select End Sub これそのものを削除してください。 ただし、選びたいセルが 同じ行のO列の場合、コンボボックスでおおわれているので選べませんよね。 選べる別のセルを選択 -> O列を選択　という操作でもよければ、それでいいですし、 いやいや、それは面倒だということなら、コンボボックスにおおわれているO列を選択する【裏ワザ】として 残しておかれてもよろしいかと。 （β） 2015/05/24(日) 19:17 ---- おかげで非常に満足のいく動作となりました。ダブルクリックのコード部分も別に削除する必要もなさそうですね。 一つだけ気になることはリストのB列のサイズに例えば2.0とだけ書かれた場合、リストで選択する場合に2だけの表示になってしまうことです。 リスト側のセルには2.0と表示されていまして、製品名入力のセルにも2ではなく2.0と表示するにはどうしたらいいでしょうか？ （たか） 2015/05/24(日) 21:00 ---- B列の 2.0 が　「文字列」の "2.0" であれば 2.0 として扱われます。（こちらで検証済み） もし、ここが、数字の 2 で、表示書式で　2.0 となっているだけなら　値としては 2 ですから 現在のコードではそのようになります。 B列入力を '2.0 とするか、あるいは B列の表示書式を文字列にした上で 2.0 と入力しておけば 2.0 として扱われますよ。 （β） 2015/05/24(日) 21:43 ---- もし、B列がすでにあるデータをそのまま利用、で、入力しなおすのが面倒ということであれば getList の With Sheets("品名リスト") With .Range("A1", .Range("A" & .Rows.Count).End(xlUp)) w1 = .Value 'A列 w2 = .Offset(, 1).Value 'B列 End With End With これを With Sheets("品名リスト") With .Range("A1", .Range("A" & .Rows.Count).End(xlUp)) ReDim w1(1 To .Count, 1 To 1) ReDim w2(1 To .Count, 1 To 1) For i = 1 To UBound(w1) w1(i, 1) = .Cells(i).Value 'A列 w2(i, 1) = .Cells(i).Offset(, 1).Text 'B列 Next End With End With で。 （β） 2015/05/25(月) 06:46 ---- 数字の表示に関しては文字列設定で対応しようと思います。 あと色々な製品名で確認していた中で、品名が短い場合は改行してサイズを足すと見栄えがあまり良くないものが出てきてしまいました。 そこでそういった製品名だけサイズもA列の品名に入れ込んで、B列のサイズを空白にしてリストを修正しようかと思ってます。 ただ今の設定だと、B列が空白でも半角スペース改行が入り込むので表示がおかしくなりますよね。 もし、B列の値が空白の場合、半角スペース＋改行を行わないようにするにはどこを変えたらいいでしょうか？ （たか） 2015/05/27(水) 00:31 ---- GetList の中の s = w1(i, 1) & " " & w2(i, 1) これを s = w1(i, 1) & IIf(w2(i, 1) = "", "", " " & w2(i, 1)) （β） 2015/05/27(水) 23:12 ---- 返事遅くなりすみません。 無事B列が空白でもうまく表示できるようになりました。 あとはA列の品名の途中でスペースがあると、文字の数に限らずそこで改行されてしまい、製品名入力セルで3行になってしまってうまく表示できないので、リストだけの調整で可能かもうちょっと試してみます。 （たか） 2015/05/31(日) 11:53 ---- はい、がんばってください。 まぁ、当初想定していたデータの構成と、実際のデータとの食い違いは間々ありますが >>スペースに関してはまだ品名やサイズ部分に入れたりは行っていません。 >>最終的には選択入力後、各自で品名の後ろにスペース入れて調整してもらってもいいのかなと思ってます。 ということだったと思います。 要件は要件として、（利用者に）しっかり守ってもらうということも大切だと思いますよ。 （β） 2015/05/31(日) 13:21 ---- 代案といいますか、こちらでの作成過程で一時期、品名□サイズ　とせず　品名●サイズ　で扱っていたことがあります。 (□は空白、●は改行） セル上も、コンボボックス上も　品名●サイズ。 こうしたとき、コンボボックスに、この●が、「変な文字」で表示されてしまい、それがなんだか好きになれないので 品名□サイズ（コンボボックス側）　<-> 品名□●サイズ（セル側）　というようにしているわけですが、 もし、コンボボックスに表示される●が気にならなければ、以下のコードにすると A列やB列にスペースがあっても、そのまま受け入れます。 変更点はわずかなんですが、フルセット、ご参考まで。 Option Explicit Dim pos As Range Dim first As Boolean Private Sub Worksheet_SelectionChange(ByVal target As Range) If Not pos Is Nothing Then pos.Value = ComboBox1.Value If Intersect(target(1), Range("N10,N12,N14,N16")) Is Nothing Then Set pos = Nothing ComboBox1.Visible = False Else first = True If IsEmpty(target(1)) Then Set pos = Nothing ComboBox1.Value = Empty Set pos = target(1) ComboSet Else Set pos = Nothing ComboBox1.Clear ComboBox1.Value = Empty Set pos = target(1) ComboBox1.Value = target(1).Value End If first = False PlaceCombo target ComboBox1.Visible = True ComboBox1.Activate End If End Sub Private Sub ComboBox1_Change() ComboSet End Sub Private Sub ComboBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean) If pos Is Nothing Then Exit Sub pos.Value = ComboBox1.Value pos.Offset(, 1).Select End Sub Private Sub ComboSet() Dim w As Variant Dim sv As String Dim tmp As Range If pos Is Nothing Then Exit Sub sv = ComboBox1.Value w = getList(ComboBox1.Value) ComboBox1.Clear If IsArray(w) Then If UBound(w, 1) = 1 Then ComboBox1.AddItem w(1) Else ComboBox1.List = w End If End If Set tmp = pos Set pos = Nothing ComboBox1.Value = sv Set pos = tmp If Not first Then ComboBox1.DropDown ComboBox1.Activate End Sub Private Function getList(myStr As String) As Variant Dim c As Range Dim w1 As Variant Dim w2 As Variant Dim w As Variant Dim i As Long Dim v As Variant Dim x As Variant Dim s As String With Sheets("品名リスト") With .Range("A1", .Range("A" & .Rows.Count).End(xlUp)) ReDim w1(1 To .Count, 1 To 1) ReDim w2(1 To .Count, 1 To 1) For i = 1 To UBound(w1) w1(i, 1) = .Cells(i).Value 'A列 w2(i, 1) = .Cells(i).Offset(, 1).Text 'B列 Next End With End With For i = 1 To UBound(w1, 1) s = w1(i, 1) & IIf(w2(i, 1) = "", "", vbLf & w2(i, 1)) If StrConv(UCase(s), vbNarrow) Like StrConv(UCase(myStr), vbNarrow) & "*" Then If IsArray(w) Then ReDim Preserve w(1 To UBound(w) + 1) Else ReDim w(1 To 1) End If w(UBound(w)) = s End If Next getList = w End Function Private Sub PlaceCombo(target As Range) ComboBox1.Top = target(1).Top ComboBox1.Left = target(1).Left - 6.48 ComboBox1.Height = target(1).MergeArea.Height ComboBox1.Width = target(1).Width * 2 + 6.48 * 3 End Sub （β） 2015/05/31(日) 19:06 ---- 代案のコードでうまく表示できるようになりました。 確かにコンボボックスの表示で見づらい感じでしたが、 s = w1(i, 1) & IIf(w2(i, 1) = "", "", vbLf & w2(i, 1))の改行部分を s = w1(i, 1) & IIf(w2(i, 1) = "", "", " " & w2(i, 1))にすることでも中々うまく表示出来ているようで、これだと短い製品名であえて品名とサイズを改行して表示させる必要もないなぁと思いました。 一行で納まらない場合うまくサイズ部分が2行目に来る感じなのでこれで使ってみようと思います。 長々と貴重な時間とご迷惑をかけまして申し訳ありませんでした。 初心者の私が質問する内容ではなかったと反省しています。 もっと勉強して自分で理解できるよう努力していきたいと思います。 ありがとうございました。 （たか） 2015/06/01(月) 01:49