質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.50%
Windows 10

Windows 10は、マイクロソフト社がリリースしたOSです。Modern UIを標準画面にした8.1から、10では再びデスクトップ主体に戻され、UIも変更されています。PCやスマホ、タブレットなど様々なデバイスに幅広く対応していることが特徴です。

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

マクロ

定義された処理手続きに応じて、どのような一連の処理を行うのかを特定させるルールをマクロと呼びます。

Q&A

0回答

6496閲覧

Excel サジェスト機能を使用して入力した出場者氏名の出場種目をプルダウンリストで入力したい

BiigBlueSea

総合スコア9

Windows 10

Windows 10は、マイクロソフト社がリリースしたOSです。Modern UIを標準画面にした8.1から、10では再びデスクトップ主体に戻され、UIも変更されています。PCやスマホ、タブレットなど様々なデバイスに幅広く対応していることが特徴です。

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

マクロ

定義された処理手続きに応じて、どのような一連の処理を行うのかを特定させるルールをマクロと呼びます。

0グッド

0クリップ

投稿2019/11/19 01:57

作業環境

Windows10、Excel2016

実現させたいこと

水泳大会で新記録が出たときに発行する記録証ファイルを作成しています。
記録証には、出場者氏名・新記録を出した出場種目等を記載します。
出場者氏名は下記2つのコードを使用して、サジェスト機能的な方法で入力します。
このとき、別のシート(下記のPersonシート)にある該当者の出場種目(1種目または2種目)をプルダウンリストで入力したいのです。
エクセル既存の機能、関数、VBA、なるべく簡単な方法を教えて戴けるとたいへん有難いです。

出場者氏名を入力するためのコード

1.標準モジュールに下記のコードを記述

vba

1Sub 入力規則リスト(str As String, cSh As Worksheet) 2 Dim buf As String, tmp As Variant 3 Dim Sh As Worksheet 4 Range("A:A").ClearContents 5 buf = str 6 tmp = Split(buf, ",") 7 Set Sh = Worksheets("配列格納") 8 Sh.Activate 9 Sh.Range(Cells(1, 1), Cells(UBound(tmp), 1)) = WorksheetFunction.Transpose(tmp) 10 Sh.Range(Cells(1, 1), Cells(UBound(tmp), 1)).Name = "リスト" 11 cSh.Activate 12End Sub 13Sub 入力候補表示(Sh As String, Rg As String, Tg As Range) 14 15 Dim foundCell As Variant 16 Dim listSheet As String '辞書のシート名 17 Dim strDictionary As String '辞書の範囲 18 Dim matchKey As String 19 Dim strFormula As String ' 入力規則に入れる文字列 20 Dim firstAddress As String ' 最初の結果のアドレス 21 Dim matchWord As String 22 Dim roopCount As Long 23 Dim lngY As Long, intX As Long 24 25 If Tg.Count > 1 Then Exit Sub 26 27 ' アクティブセルの値が辞書に載っているか検索 28 listSheet = Sh ' 検索対象シート 29 30 strDictionary = Rg ' 検索対象範囲 31 32 matchKey = Tg.Value 33 34 '部分一致で検索する(完全一致での検索を回避) 35 Set foundCell = Worksheets(listSheet).Range(strDictionary).Find( _ 36 What:=matchKey, LookAt:=xlPart) 37 38 ' 検索結果が空の場合終了 39 If foundCell Is Nothing Then Exit Sub 40 41 ' 検索結果を回す 42 43 strFormula = "" 44 roopCount = 0 45 firstAddress = foundCell.Address 46 Do 47 ' 辞書から入力候補を収集 48 lngY = foundCell.Cells.Row 49 intX = foundCell.Cells.Column 50 matchWord = Worksheets(listSheet).Cells(lngY, intX).Value 51 52 '比較 53 If InStr(matchWord, matchKey) > 0 Then 54 strFormula = strFormula & matchWord & "," 55 End If 56 57 roopCount = roopCount + 1 58 59 ' 次の入力候補へ 60 Set foundCell = Worksheets(listSheet).Range(strDictionary).FindNext(foundCell) 61 62 Loop While (Not foundCell Is Nothing) And (firstAddress <> foundCell.Address) 63 64 ' 入力候補をセット 65 Application.EnableEvents = False 66 67 68 If roopCount = 1 Then 69 '候補が一つの場合、それを入力 70 71 If Tg = "" Then 'エラー処理 72 Application.EnableEvents = True 73 strFormula = "" 74 Tg.Select 75 Exit Sub 76 Else 77 Tg.Value = Left(strFormula, Len(strFormula) - 1) 78 End If 79 80 ElseIf Len(strFormula) > 0 Then 81 82 83 'リストという名前の範囲を生成し配列を代入する 84 Application.ScreenUpdating = False 85 Call 入力規則リスト(strFormula, ActiveSheet) 86 Application.ScreenUpdating = True 87 '候補が複数ある場合は、候補のリストを表示 88 On Error GoTo ErrorHandler 89 With Tg.Validation '入力規則を設定 90 .Delete 91 .Add Type:=xlValidateList, Formula1:="=リスト" 92 .ShowError = False 93 .InCellDropdown = True 94 End With 95 Tg.Select 96 SendKeys "%{DOWN}" 97 End If 98 99 Set foundCell = Nothing 100 strFormula = "" 101 Application.EnableEvents = True 102 103ErrorHandler: 104 Application.EnableEvents = True 105 strFormula = "" 106End Sub

2.イベントを起こしたいシート(個人種目用シート)に下記のコードを記述

vba

1Private Sub Worksheet_Change(ByVal target As Range) 2 3 '辞書(住所の候補)を設定する:郵便番号データから候補表示 4 'DicSheetNameは辞書のシート名、 5 'DicRangeAddressは辞書の範囲を指定する 6 ' 7 Const DicSheetName = "Person" 8 Const DicRangeAddress = "A:A" 9 10 If target.Count > 1 Then 11 '選択セルが2つ以上は無効 12 Set target = Nothing 13 Exit Sub 14 15 ElseIf Application.Intersect(target, Range("AS4")) Is Nothing Then 16 '※入力セル以外の変更では無効(targetと共有するセル範囲がない) 17 Exit Sub 18 19 Else 20 '入力されたアドレスが住所入力のアドレスの場合に候補を表示 21 Call 入力候補表示(DicSheetName, DicRangeAddress, target) 22 End If 23 24End Sub

上記2つのコードは、下記のウェブサイトを参考にしました。
エクセルでグーグルサジェストっぽい入力をする

ファイルの構成

  1. 個人種目用シート

出場者氏名・新記録を出した種目等を入力するシートです。
出場者氏名はサジェスト機能を使用してAS4へ入力します。
新記録を出した種目を入力するセルは、AT4です。このAT4への入力をプルダウンリストから選択する方法にしたいのです。
このシートのA1:AQ63を記録証として印刷します。
イメージ説明
0. リレー用シート
今回の問題には直接関係しません。
0. Personシート
出場者氏名、フリガナ、所属クラブ、出場種目等のデータベース的シートです。
出場者氏名はA列、出場種目はG列とJ列です。
G列のみ値がある(1種目だけ出場する)、G列とJ列両方とも値がある(2種目出場する)、G列とJ列両方とも値がない(競技役員として参加する)の3パターンがあります。
イメージ説明
0. Teamシート
今回の問題には直接関係しません。
0. 配列格納
出場者氏名をサジェスト機能的な方法で入力するために、配列に格納した文字列を書き出すシートです。
名前をつけて入力規則で参照します。
上記の参考ウェブサイトの「リスト用シート」に該当します。

以上

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

guest

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

まだ回答がついていません

会員登録して回答してみよう

アカウントをお持ちの方は

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.50%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問