No title
VBA
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
'入力規則のリストにサジェスト機能を実装。
'リストデータを上から検索し、
'入力した文字と部分一致したデータをリストに表示する。
'入力セルを空白にした（削除した）場合はリストの全データを表示する。
'作業用シートは使用せず、セル一つ一つにリストを設定する
'対象セル以外のセルへの入力時はマクロを終了させる
If Target.Count > 1 Then Exit Sub
If Target.Row <= 4 Then Exit Sub
If Target.Column <> 1 Then Exit Sub
'イベントの抑制と対象セルの入力規則の削除
Application.EnableEvents = False
Target.Validation.Delete
'シートオブジェクト・レンジオブジェクトの宣言----------------------------------
Dim listWs As Worksheet
Dim listArea As Range
Dim lastRow As Long
Set listWs = Sheets("リスト")
lastRow = listWs.Cells(Rows.Count, 1).End(xlUp).Row
Set listArea = listWs.Range(listWs.Cells(2, 1), listWs.Cells(lastRow, 1))
'------------------------------------------------------------------------------
'以降3つに分岐
'①そもそも入力した文字がリストのデータのいずれかと完全一致している場合
'リストを表示せずに終了
'②入力セルが空白の場合
'リストの全データを表示させる
'③上記以外
'部分一致したリストを表示させる
'①-----------------------------------------------------------------------------
If Not IsError(Application.Match(Target.Value, listArea, 0)) Then
Application.EnableEvents = True
Exit Sub
End If
'------------------------------------------------------------------------------
'②-----------------------------------------------------------------------------
If Target.Value = "" Then
Target.Validation.Add Type:=xlValidateList, Formula1:="=" & listArea.Address(External:=True)
Target.Validation.ShowError = False
Application.EnableEvents = True
Exit Sub
End If
'------------------------------------------------------------------------------
'③-----------------------------------------------------------------------------
'方法
'InStr関数を使用し、リストデータ内に入力した文字が含まれているか上から確認していく
'（InStr関数にはvbTextCompareを適用：かな,カナ 全角半角 大文字,小文字を区別しない様にするため）
'含まれていたら、Hits変数にカンマ区切りでヒットした文字列を連結していく。
'リストに設定できる文字列が255文字までなので、Hits変数を255文字まで切り取る。
'切り捨てた後に残った半端な文字列も切り捨てる。
'最後に、入力セルにHits変数をリストとして設定する。
If Target.Value <> "" Then
Dim rng As Range
Dim Hits As String
Const chaLimit As Long = 255
For Each rng In listArea
If InStr(1, rng.Value, Target.Value, vbTextCompare) > 0 Then
Hits = Hits & rng.Value & ","
If Len(Hits) >= chaLimit Then Exit For
End If
Next
If Hits <> "" Then
Hits = Left(Hits, chaLimit)
Hits = Left(Hits, InStrRev(Hits, ",") - 1)
Target.Validation.Add Type:=xlValidateList, Formula1:=Hits
Target.Validation.ShowError = False
Else
Target.Validation.Add Type:=xlValidateList, Formula1:="該当なし"
Target.Validation.ShowError = False
End If
Target.Select
SendKeys "%{Down}"
End If
'------------------------------------------------------------------------------
'イベント抑制の解除
Application.EnableEvents = True
End Sub
