Excelの入力規則のリストをサーチキーで絞り込むマクロを改良。絞り込んだ結果が１つの場合にはリストを表示しないようにしました。

Option Explicit

Sub siborikomi()

'■Ｃ列に入力されたサーチキー（アルファベット）で勘定科目を絞り込み
'■入力規則に表示させるマクロ （サジェスト機能）
'■絞り込んだ結果、勘定科目が1つしかない場合にはその科目を表示する


'■変数宣言

Dim listbox As Variant
Dim i As Long
Dim lastrow As Long
Dim j As Long


'■最終行の取得　マスタを作成している場所を参照する

lastrow = Cells(Rows.Count, 6).End(xlUp).Row


'■処理実行部分

    '■アクティブセル（Ｃ列のセル）に入力されたアルファベットのサーチキーでＦ列からInstr関数で該当する勘定科目を検索する
    '■もし該当する勘定科目があれば変数「listbox」に格納する
    '■マスタに登録された勘定科目の数だけ繰り返す。（lastrowで登録された勘定科目の数を取得する)
    
    
For i = 2 To lastrow


    If Range("f" & i).Value <> "" Then
    
        If InStr(Range("g" & i).Value, ActiveCell.Value) = 1 Then
           
              listbox = listbox + Range("f" & i).Value + ","
              
              j = j + 1
    
        End If
    
    End If
    

Next i


    '■変数「listbox」に何らかの勘定科目が格納されている場合に、入力規則をＣ列に設定する。

If Len(listbox) > 0 Then

    
      '■検索にヒットした勘定科目が１つしかない場合の処理（その科目をアクティブセルに入力する）
    
    
    If j = 1 Then
    
        Range("c:c").Validation.Delete  '■入力規則をクリアする　※必須。これがないとエラーが発生する。
        
        Range("c:c").Validation.Add Type:=xlValidateInputOnly '■すべての値を入力可
        
        Range("c:c").Validation.IMEMode = xlIMEModeOff '■サーチキーを使いやすくするために日本語入力をオフにする
        
        '■変数「listbox」に格納された文字列のうち、「,」を除いてアクティブセルに表示する
        
        ActiveCell.Value = Left(listbox, Len(listbox) - 1)
        
    
    Else
    
    
         '■検索にヒットした勘定科目が２以上の場合の処理
    
    
        Range("c:c").Validation.Delete  '■入力規則をクリアする　※必須。これがないとエラーが発生する。
        
        Range("c:c").Validation.Add Type:=xlValidateList, Formula1:=listbox  '■絞り込んだ勘定科目で入力規則をセットする
        
        Range("c:c").Validation.IMEMode = xlIMEModeOff '■サーチキーを使いやすくするために日本語入力をオフにする
        
        Range("c:c").Validation.ShowError = False  '■入力規則にないデータ（勘定科目）を入力してもエラーにならないようにする
        

    End If

End If

End Sub