[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『Excelでサイジェスト』(たか)
過去の内容を拝見して同じようにやってみたのですが、私の条件ではうまくいかず、動作しなかったので質問させていただきます。
入力シートのN10からN16の結合セル4つを対象に品名を入力するようになっています。
ここに入力するとき「品名リスト」の別シートのA3から下に入力してある品名を参照して、入力支援してくれるようにしたいのですが、リストにない場合は普通に入力されたものになるようにしたいと思ってます。
初心者のため分からないことが多いですがアドバイス等よろしくお願いします。
< 使用 Excel:Excel2013、使用 OS:Windows8 >
それで、
どこまでご自分でトライして、現在、何に詰まっているのか教えてください。
入力規則はもう設定されているのですか、それともこれから?
マクロ記録とかとってみたのですかね。
コードが部分的にもあるならそれを提示して欲しいです。
# ちなみに、"サイジェスト"って何ですか? 何かの流行ですか?
# 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
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 '選択セルが2つ以上は無効 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.
なので、抜けてきた後、エラー判定されてしまってますねぇ。
回避する案、いくつか思いつくんですが、↑でふれたように、セル上での入力による制御は面倒かもしれません。 1文字ごとに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
>>大文字と小文字を区別なく入力
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 を2セルずつ結合。 で、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
>>トレードオフですね。
絞り込み対象が1つだった時、選択の必要がないということで、v(1) から強制的にセットした上で 入力規則を解除しているんだと思われますが、リストにないものをいれてエンターしますと 絞り込み 0 件になって k = 0 。で、そのまま受け入れられてセルに残るというのが、こちらでの状況です。 操作手順によって、そうならないケースがあるのかもしれませんね。 いずれにしても、このセルイベントを利用する方式だと、文字タイプのみでは認識されず、たとえば A とタイプして確定のためにEnter。 で、続けて AB としたい場合、フォーカスがリストに行ってますので、もう一度セルを選び、 A を AB にしてEnter。
使いづらいなぁと思いました。
で、γさんご示唆のActiveXでどうかなと、試してみたんですが、日頃、「Changeイベントは1文字ごとに発生するので使い物にならない」 こう思っていましたけど、逆に1文字ごとに発生するのでEnterなしでも処理可能。 おぉ、なかなかいいじゃないかと、Changeイベントを見直した次第です。
>>Option Compare Text
そうですね! 少なくとも本件では、このモジュール全体で、この設定に不都合はありませんので。 ただ、この先、このモジュール内で、別の比較ロジックを追加していった場合、Option Compare Text の記述のことを 忘れてしまって悩む場面もあるかも・・ということで、まだるっこしいのですが、これを使いました。
>>あれだけで、想像できるわけがない。
γさんの疑問投げかけでコードが登場し、あぁ、こんなことなのかとわかりましたので、助かりました。 ただ、もしかしたら・・・コードでは入力規則で処理しているわけですけど、質問者さんは、それに気が付いていなかったのかも。
(β) 2015/05/18(月) 07:47
お望みの形かどうか自信ありませんが、
・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行結合ということですけど、ここを「折り返して全体を表示」と設定してあるなら、2行分はおさまりますが) 収まらなければ、O列が空白なら、そこにまたがって表示されますが、O列に値があれば、収まりませんよね。
たとえば、リストの元ネタ、品名リストのA列ですけど、そこでは、収まっているのですか? もし、収まっているなら、N列の幅を品名リストのA列と同じにしておけばよろしいと思いますが? コンボボックス等の幅は、コード内で、N列の幅にあわせるようにしていますので。
品名リストには、セル幅に収まるようなものだけが登録されているけど、それ以外の任意の品名を入力した時に それが長くて、収まりきらないということでしょうか? それも、同じで、コンボボックス等で細工をしても、セルに入れば、収まりきらないわけですよね?
文字数をカバーする長さは、エクセルでは(なぜか)すんなりとは取得できません。 ですから、それにあわせて、ぐ〜んと自動的に幅を広げるというのは、やっかいです。 ただ小細工はできます。これが必須要件であれば、そういう小細工をすることも考えられますが その前に、上で述べたようなことを検討してみてください。
●それとは別に、品名リストは A3 からだったんですね。アップしたコードでは A1 からにしていました。 コード内に2か所ある A1 を A3 に変更してください。
To γさん
>>βさんの ActiveX利用の手法は なかなか良いですね。 勉強になります。
大師匠のγさんに言われると、汗、汗で緊張します。 コード自体は、結構、急いで書いたところもありますし、この時は、このイベントが発生するはずだから そちらで、こうやって、もどってこうやってと、書きながら、(推敲不十分のまま)ながれで記述していますので じっくり見ると、無駄なところもありそうですし、操作の手順によっては不具合が発生するところもあるかもしれません。 気が付かれたことがあれば、ご指摘いただければ幸甚です。
(β) 2015/05/19(火) 07:01
>># 私は昔、AdvancedFilterとChangeイベントの組み合わせで似たような仕組みを >># 作ったことがあります。
フィルターオプションもいい方法ですよね。 つい最近(γさんも、コメント寄せられていましたが)別の板で、オートフィルターで処理したものを提案したことがあります。 今回は、アップされたオリジナルコードで Like 比較をしていたので、なんとなく、それを継承。
おそらく、抽出の効率はフィルターオプション(今は、死語?)が最も優れているのでしょうね。
(β) 2015/05/19(火) 07:11
>>コンボボックス・リストボックスの仕様上
あっ! もしかして、基本的にはセル幅に収まるんだけど、コンボボックス等では、先頭に、1文字分ぐらいの すきまができて、その分、(コンボボックス等の上の表示では)おさまらないということでしょうか? (コンボボックスの場合、最後の▼も1文字分ぐらい占有してますね) それであれば、その幅を、セル幅 + ちょっと にしておけばよろしいと思います。
(β) 2015/05/19(火) 07:23
外出していて、レス遅れました。
(β) 2015/05/19(火) 07:01 と(β) 2015/05/19(火) 07:23 で、セルに入りきらないということは、 具体的にはどのようなことをいってますかと質問しているんですが、その回答をお待ちします。
加えて、そちらで試したら、こういうときに、こうなってしまう。これを、このようにできないかということを 具体的な例で示していただけませんか。
あと、
>>変更は難しいのでリストの方で調整をやってみたいと思います。
この意味は、(たか)さんが、調整されるということですね? そうではなくβに調整させたいということであれば、「リストのほう」というのが何を意味しているのかを教えてください。
(β) 2015/05/19(火) 22:06
了解です。
(β) 2015/05/20(水) 05:08
最終的に、どのコントロールで処理されるかは、ご自身で判断されるとして、コード中のコントロールの位置につき
.Left = ●●● .Width = ■■■
となっているところを
.Left = ●●● - 6.48 .Width = ■■■ + 6.48 * 3
ぐらいにすれば、(もしかしたら)イメージにあうかもしれません。
(β) 2015/05/20(水) 09:39
そうですねぇ。
たとえば コシヒカリ 魚沼産棚田米 とか コシヒカリ 小国産棚田米 といった長い名前のものを A列 B列 コシヒカリ 魚沼産棚田米 コシヒカリ 小国産棚田米
こんな感じですかね。 トライされたように、これを2列データとしてコンボボックスに表示させるのは可能ですが、あくまで入力し抽出させるトリガーとしては いずれか1つの列。 ただ選んだ結果を、2行連結されたセルに その内容を 「1つの文字列」の 「コシヒカリ 魚沼産棚田米」として、かつ表示は コシヒカリ 魚沼産棚田米 とセル内改行の形で表示させることはテクニックとしては可能だと思います。
ただ、この方式をとるなら、すべての商品をそういう扱いにし、セル内上段の文字列でのみ A列を検索することになります。
それが、運用としてどうか、ちょっと、イメージがわかないところもありますが、ちょっと書いてみましょうか。 (でも、使い物にならないということになるかもしれませんがね) (β) 2015/05/23(土) 17:09
↑
>>ちょっと書いてみましょうか
ということで、ちょこっと書いて動きをみてみましたが、あまり使いやすそうでもないです。 別の方法を考える必要がありますねぇ。
(β) 2015/05/23(土) 17:42
思い付きですが。
・商品登録のリストそのものを 長いものはセル内改行で(適切な位置で改行)登録しておく。(あくまで商品文字列は1つ) ・コンボボックスの幅はマクロ内で現在の2倍ほどにする。
そうすると、
コシヒカリ 魚沼産棚田米
とセル内改行で登録されている商品は、コシヒカリ$魚沼産棚田米 ($は実際には改行コード文字) としてコンボボックスのリストにひょうじされ、最終的に選ばれれば、当該セルには
コシヒカリ 魚沼産棚田米
と、セル内改行で表示される。
この形であれば、現行のコード、ほとんど、そのまま、コンボボックスの幅をなおすぐらいでいけますけど いかがですか?
(β) 2015/05/23(土) 18:18
↑ と、思ってちょこちょこっとやってみたけど、苦戦中。だめかも。
(β) 2015/05/23(土) 18:39
苦戦はかわりませんが、少し光が見えてきたところです。
ところで、以前、製品名そのものが長いので折り返して2行表示 といった話題がありましたが 仮に、サイズがあるものについてなんらかの対応をしたとして、製品名そのものの長さがどうこうということは 忘れていいですね? いやいや、両方ということであれば、ロジック的なこともありますが、UIとして、今の構えでは無理っぽいので。 どうしても、両方の場合は、(たか)さんのほうで、こういう持ち方で、こういうレイアウトにするので、このように表示して セルには、これこれのように転記したいと、具体的なイメージを作り上げて投げかけてもらう必要があります。
さて、サイズを持つ製品についてはサイズ列も処理に取り入れたとして
製品A Size1 製品A Size2 製品B 製品C SizeA 製品D
こんな2列があったとして、
まず N列に書きこむ対象は 製品名だけですか? それとも サイズも含めた2行表示ですか? サイズも含めた2行表示の場合、あくまで文字列としては1つですから、N列に書きこまれているものが 逆にいえば製品名ではないということになりますが。
あるいは、N列の行結合をやめ、N10が製品名、N11がサイズ というような扱いもできますが?
それと、コンボボックスのリストとしては
製品A●Size1 製品A●Size2 製品B 製品C●SizeA 製品D
と、製品名とサイズの間に、何か区切りコードを(マクロ内で)いれて扱うことになると思っています。 この区切りコードは、半角スペースなんかが扱いやすいのですが、もし、製品名やサイズそのものに 半角スペースがあるなら、どこが区切りかわからなくなりますので、文字列では使われない特殊文字を 使う必要がでてきます。
もちろん、ふつうに、コンボボックスを2列にすることもできます。 ただ、その場合、あくまで、コンボボックス内は製品名だけで、サジェスト機能も製品名だけの範囲になります。 (ドロップダウンしたコンボボックスのリストは2列表示ですが) これでよければ、そのほうがコード的には素直です。 で、N列には、その製品名だけが入るんですが、行結合をやめれば N10に製品名、N11にサイズということもできます。
(無理やり、製品名●サイズ として転記することもできますが、↑でふれたように、N列の値が製品名ではなくなるということと 区切り文字を何にしようかという課題は残ります)
そのあたりはいかがですか?
あと、もう1つ教えてください。 コンボボックスで選択しN列のセルに書きこんだ後、操作者が次に入力するセルは N列の1つ下の結合セルですか? それとも、今書きこんだ行の右のセル(O列)ですか? コンボボックスの幅を長くする必要があると思っていて、その場合、O列が、コンボボックスにおおわれてしまうので コンボボックスでの選択後、O列をマウスで選択することができなくなり、一度、別のセルをクリックして コンボボックスを非表示にするというのが、やってみると面倒だなぁと感じましたので。 コンボボックスで選択されたら自動的に「次のセル」にフォーカスを移し、コンボボックスを非表示にしようと思っています。 その「次のセル」を、下にしたらいいのか、右にしたらいいのか、それは、そちらの入力順として どちらがいいのかによりますので。
(β) 2015/05/24(日) 05:58
アップ済みのコードもそうでしたが、イベントの連鎖を抑止したり、あるいは連鎖を利用したりと、なんだか あぶなっかしい綱渡りのような流れなので、自信度 50%ぐらい。
A列に品名、B列にサイズ。コンボボックス上は 品名□サイズ(□は半角スペース) で、選択されてN列に転記されると、品名□●サイズ になるのでこのセルの値の扱いには注意願います。(●は改行コード)
コンボボックスの幅を2倍にしたので、次の列のセルを選択できないことから、面倒かもしれないけど 選択終了(あるいは直接入力終了)したら、コンボボックスをダブルクリックしてください。
やってみて、具合悪ければ指摘願います。
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
(たか) 2015/05/24(日) 17:25
ん?
シートモジュールの先頭に
Option Explicit
Dim pos As Range Dim first As Boolean
この記述があってもエラーになるんですか????
(β) 2015/05/24(日) 18:15
指摘のエラーとは関係ない部分ですが、N列を選択した時に、コンボボックスに、それ以前に入っていた値が 消えずに表示されるケースがあります。
後ほど、そこは訂正してアップします。
(β) 2015/05/24(日) 18:22
それでは、ダブルクリックしなくても、別のセルを選べば、その時の値がセルに書きこまれるように変更。 あわせて、ケースによっては、前のコンボボックスの値が残ってしまっている点を修正。 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.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
GetList の中の
s = w1(i, 1) & " " & w2(i, 1)
これを
s = w1(i, 1) & IIf(w2(i, 1) = "", "", " " & w2(i, 1))
(β) 2015/05/27(水) 23:12
はい、がんばってください。 まぁ、当初想定していたデータの構成と、実際のデータとの食い違いは間々ありますが
>>スペースに関してはまだ品名やサイズ部分に入れたりは行っていません。 >>最終的には選択入力後、各自で品名の後ろにスペース入れて調整してもらってもいいのかなと思ってます。
ということだったと思います。 要件は要件として、(利用者に)しっかり守ってもらうということも大切だと思いますよ。
(β) 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
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.