Excel VBA 「実行時エラー1004 rangeメソッドは失敗しました。globalオブジェクトのエラー」を解決するコード

Question

作業環境

Windows10、Excel2016

やりたいこと

水泳大会で新記録が出たときに記録証を都度印刷します。
記録証印刷用のシートに出場者氏名を入力する必要があるのですが、直接入力では漢字を間違える可能性があり、データの入力規則のリスト入力は出場者数が500名近いので事実上使用できません。
そこで、VBAでGoogle検索のサジェスト機能的なものをExcelのシート上につくって出場者氏名の入力を効率化したいのです。

問題点

下記のウェブサイトを参照してファイルを作成しましたが、表題のエラーが発生してしまいます。
デバッグしたところ、下記1つ目のコードの4行目：Range("リスト").ClearContentsでエラーが発生しています。
自分のできる範囲で解決方法を模索してみましたが、どのようにコードを改変したら良いのかわかりません。
エラーを解決するコードを教えて下さい。宜しくお願い致します。

参考にしたウェブサイト

ググル × blog エクセルでグーグルサジェストっぽい入力をする
リンク内容

ファイルの構成

1. 個人種目用シート

サジェスト機能を利用して出場者氏名を入力するシートです。
入力するセルは、AS4です。
このシートのA1:AQ63を記録証として印刷します。

0. リレー用シート
今回の問題には直接関係しません。
0. Personシート
出場者氏名、フリガナ、所属クラブ、出場種目等のデータベース的シートです。
サジェスト機能の入力候補の対象になる出場者氏名は、A列にあります。

0. Teamシート
今回の問題には直接関係しません。
0. 出場種目シート
今回の問題には直接関係しません。
0. 配列格納
配列に格納した文字列を書き出すシートです。
名前をつけて入力規則で参照します。
参考にしたウェブサイトの「リスト用シート」に該当します。

2つのコード

※シート名を変更しただけで、それ以外の部分は参考にしたウェブサイトのコードをそのまま使用しました

◎標準モジュールのModule1に以下のコードを記述

Sub 入力規則リスト(str As String, cSh As Worksheet)
    Dim buf As String, tmp As Variant
    Dim Sh As Worksheet
    Range("リスト").ClearContents　'この行で表題のエラーが発生する（注.質問者）
    buf = str
    tmp = Split(buf, ",")
    Set Sh = Worksheets("配列格納")
    Sh.Activate
    Sh.Range(Cells(1, 1), Cells(UBound(tmp), 1)) = WorksheetFunction.Transpose(tmp)
    Sh.Range(Cells(1, 1), Cells(UBound(tmp), 1)).Name = "リスト"
    cSh.Activate
End Sub
Sub 入力候補表示(Sh As String, Rg As String, Tg As Range)

    Dim foundCell As Variant
    Dim listSheet As String '辞書のシート名
    Dim strDictionary As String '辞書の範囲
    Dim matchKey As String
    Dim strFormula As String ' 入力規則に入れる文字列
    Dim firstAddress As String ' 最初の結果のアドレス
    Dim matchWord As String
    Dim roopCount As Long
    Dim lngY As Long, intX As Long
   
    If Tg.Count > 1 Then Exit Sub
               
    ' アクティブセルの値が辞書に載っているか検索
    listSheet = Sh ' 検索対象シート

    strDictionary = Rg  ' 検索対象範囲

    matchKey = Tg.Value

    '部分一致で検索する（完全一致での検索を回避）
    Set foundCell = Worksheets(listSheet).Range(strDictionary).Find( _
    What:=matchKey, LookAt:=xlPart)

    ' 検索結果が空の場合終了
    If foundCell Is Nothing Then Exit Sub

    ' 検索結果を回す

    strFormula = ""
    roopCount = 0
    firstAddress = foundCell.Address
    Do
        ' 辞書から入力候補を収集
        lngY = foundCell.Cells.Row
        intX = foundCell.Cells.Column
        matchWord = Worksheets(listSheet).Cells(lngY, intX).Value

        '比較
        If InStr(matchWord, matchKey) > 0 Then
            strFormula = strFormula & matchWord & ","
        End If
   
        roopCount = roopCount + 1

        ' 次の入力候補へ
        Set foundCell = Worksheets(listSheet).Range(strDictionary).FindNext(foundCell)
   
    Loop While (Not foundCell Is Nothing) And (firstAddress <> foundCell.Address)

    ' 入力候補をセット
    Application.EnableEvents = False


    If roopCount = 1 Then
    '候補が一つの場合、それを入力

        If Tg = "" Then 'エラー処理
                Application.EnableEvents = True
                strFormula = ""
                Tg.Select
                Exit Sub
        Else
            Tg.Value = Left(strFormula, Len(strFormula) - 1)
        End If
   
    ElseIf Len(strFormula) > 0 Then


    'リストという名前の範囲を生成し配列を代入する
    Application.ScreenUpdating = False
    Call 入力規則リスト(strFormula, ActiveSheet)
    Application.ScreenUpdating = True
    '候補が複数ある場合は、候補のリストを表示
        On Error GoTo ErrorHandler
        With Tg.Validation '入力規則を設定
            .Delete
            .Add Type:=xlValidateList, Formula1:="=リスト"
            .ShowError = False
            .InCellDropdown = True
        End With
        Tg.Select
        SendKeys "%{DOWN}"
    End If

    Set foundCell = Nothing
    strFormula = ""
    Application.EnableEvents = True

ErrorHandler:
    Application.EnableEvents = True
    strFormula = ""
End Sub

◎個人種目用シート（＝イベントを起こしたいシート）に以下のコードを記述

Private Sub Worksheet_Change(ByVal target As Range)
   
    '辞書（住所の候補）を設定する：郵便番号データから候補表示
    'DicSheetNameは辞書のシート名、
    'DicRangeAddressは辞書の範囲を指定する
    '
    Const DicSheetName = "Person"
    Const DicRangeAddress = "A:A"

     If target.Count > 1 Then
     '選択セルが２つ以上は無効
         Set target = Nothing
         Exit Sub
 
     ElseIf Application.Intersect(target, Range("AS4")) Is Nothing Then
      '※入力セル以外の変更では無効(targetと共有するセル範囲がない）
         Exit Sub
   
     Else
         '入力された氏名が入力のアドレスの場合に候補を表示
             Call 入力候補表示(DicSheetName, DicRangeAddress, target)
     End If
     
End Sub

以上

Answer 1

コードの内容は精査していないですが、
Range("リスト").ClearContents
で、エラーかでるということは、「リスト」という名前の定義の範囲がないということだと思います。
事前に、適当な範囲に「リスト」という名前定義を設定しておけばいいと思います。

あるいは、下記のようにエラーを無視して次へ進むようにしておけばいいでしょう。

On Error resume Next
Range("リスト").ClearContents
On Error Goto 0

その後のコードで、「リスト」という名前の定義の範囲を再設定していますので。

コメントへの回答

ただ、個人種目シートのAS4セル（出場者氏名を入力するセル）に設定していた入力規則の日本語入力が「オン」から「コントロールなし」になってしまいます。

入力規則の日本語入力を「オン」のままにするコードはないでしょうか？

質問タイトルからは外れることなので本来は新規に質問しなおすべきですが、

        With Tg.Validation '入力規則を設定
            .Delete
            .Add Type:=xlValidateList, Formula1:="=リスト"
            .ShowError = False
            .InCellDropdown = True
            .IMEMode = xlIMEModeOn 'これを追加
        End With

IMEMode プロパティ (Excel) | Microsoft Docs

Comments

[BiigBlueSea]

ご回答有難うございました。
ご指摘のとおりにコードを改変したところ正常に作動し、たいへん安心しました。
有難うございました。

ただ、個人種目シートのAS4セル（出場者氏名を入力するセル）に設定していた入力規則の日本語入力が「オン」から「コントロールなし」になってしまいます。
入力規則の日本語入力を「オン」のままにするコードはないでしょうか？
表題の質問からは外れてしまいますが、もしご存知でしたらご教授戴けると幸いです。

[BiigBlueSea]

つけ足しの質問へのご回答、恐縮です。
IMEModeプロパティのリンクも今後の参考に致します。
hatena19さんのご協力を得て、無事日本語入力「オン」のままサジェスト機能を使用することができます。たいへん感謝しております。有難うございました！

Answer 2

Range("リスト")が実在しないのではないでしょうか。

以下のように範囲指定を明確にしてみてください。
Range("A1:C200")

Comments

[BiigBlueSea]

ご回答有難うございました。
どうやら初歩的なミスのようで、お恥ずかしい限りです。
ご指摘戴き、たいへん感謝しております。