anonymous No title
No License VBA
2020年08月24日
Copy Clone
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)


'入力規則のリストにサジェスト機能を実装。

'入力した文字をリストデータから探し、部分一致したデータをリストとして表示する。
'入力セルを空白にした(削除した)場合はリストの全データを設定する。表示はしない。
'部分一致したデータを表示するために「検索候補シート」を作業用として使用。




'対象セル以外のセルへの入力時はマクロを終了させる
If Target.Count > 1 Then Exit Sub
If Target.Address <> Range("B5").Address Then Exit Sub


'イベントの抑制と対象セルの入力規則の削除
Application.EnableEvents = False
Target.Validation.Delete


'シートオブジェクト・レンジオブジェクトの宣言---------------------------------------------------
Dim listWs As Worksheet
Dim listArea As Range
Dim lastRow As Long
Dim hitWs As Worksheet
Dim hitArea As Range


Set listWs = Sheets("リスト")
lastRow = listWs.Cells(Rows.Count, 1).End(xlUp).Row
Set listArea = listWs.Range(listWs.Cells(2, 1), listWs.Cells(lastRow, 1))

Set hitWs = Sheets("検索候補")
Set hitArea = hitWs.Range("A:A")
hitArea.ClearContents
'-----------------------------------------------------------------------------------------------


'以降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を適用(カナ,かな 全角半角 大文字,小文字を区別しないようにするため)
'含まれていたら、そのデータを「検索候補シートのA列」に列記していく。
'最後に、入力セルに「検索候補シートのA列」をリストとして設定する。

If Target.Value <> "" Then
 Dim rng As Range
 Dim cnt As Long
 Dim Hits As String
 
  For Each rng In listArea
   If InStr(1, rng.Value, Target.Value, vbTextCompare) > 0 Then
    cnt = cnt + 1
    hitArea(cnt).Value = rng.Value
   End If
  Next
  Target.Validation.Add Type:=xlValidateList, Formula1:="=" & hitArea.Address(external:=True)
  Target.Validation.ShowError = False
End If

'-----------------------------------------------------------------------------------------------


'入力セルを選択し、リストを表示する
Target.Select
SendKeys "%{Down}"

'イベント抑制の解除
Application.EnableEvents = True

End Sub
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)


'入力規則のリストにサジェスト機能を実装。

'入力した文字をリストデータから探し、部分一致したデータをリストとして表示する。
'入力セルを空白にした(削除した)場合はリストの全データを設定する。表示はしない。
'部分一致したデータを表示するために「検索候補シート」を作業用として使用。




'対象セル以外のセルへの入力時はマクロを終了させる
If Target.Count > 1 Then Exit Sub
If Target.Address <> Range("B5").Address Then Exit Sub


'イベントの抑制と対象セルの入力規則の削除
Application.EnableEvents = False
Target.Validation.Delete


'シートオブジェクト・レンジオブジェクトの宣言---------------------------------------------------
Dim listWs As Worksheet
Dim listArea As Range
Dim lastRow As Long
Dim hitWs As Worksheet
Dim hitArea As Range


Set listWs = Sheets("リスト")
lastRow = listWs.Cells(Rows.Count, 1).End(xlUp).Row
Set listArea = listWs.Range(listWs.Cells(2, 1), listWs.Cells(lastRow, 1))

Set hitWs = Sheets("検索候補")
Set hitArea = hitWs.Range("A:A")
hitArea.ClearContents
'-----------------------------------------------------------------------------------------------


'以降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を適用(カナ,かな 全角半角 大文字,小文字を区別しないようにするため)
'含まれていたら、そのデータを「検索候補シートのA列」に列記していく。
'最後に、入力セルに「検索候補シートのA列」をリストとして設定する。

If Target.Value <> "" Then
 Dim rng As Range
 Dim cnt As Long
 Dim Hits As String
 
  For Each rng In listArea
   If InStr(1, rng.Value, Target.Value, vbTextCompare) > 0 Then
    cnt = cnt + 1
    hitArea(cnt).Value = rng.Value
   End If
  Next
  Target.Validation.Add Type:=xlValidateList, Formula1:="=" & hitArea.Address(external:=True)
  Target.Validation.ShowError = False
End If

'-----------------------------------------------------------------------------------------------


'入力セルを選択し、リストを表示する
Target.Select
SendKeys "%{Down}"

'イベント抑制の解除
Application.EnableEvents = True

End Sub
No one still commented. Please first comment.