VBAの動作について

投稿者 : 初心者     投稿日時 : 2025/03/04(Tue) 09:35:52     OS : Windows 11     EXCEL : Office 365

---

社内で使用するデータを作成しています。AシートのB列に情報を入力するのですが、B列へ入力した値からマスターデータの内容を転記するため、マスターデータと同じように入力をしたいです。入力はカタカナです。初心者のため、chatGPTを使用してコードを作成しています。あまり知識はないので出来上がったコードを見て、修正などするときは、検索しながら微調整をしています

行いたい処理の内容としては、
①ＡシートのＢ列に値を入力し、変化した値をＢシートの所定セルに代入
②代入したセルをもとにＢシート内のリストからフィルター関数を使用して候補を絞り込み（スピル表示）
③表示された候補を入力中のＡシートＢ列の選択中のセルに入力規則設定（リスト：範囲は②のスピル範囲）→プルダウン表示
④プルダウンから選択し、入力確定
⑤セル移動時に入力したセル（さっきまで選択していたセル）の入力規則解除（上書きなどによる変更に対応するため。）
以上が行いたい処理です。

①～④の処理は下の【コード①】、⑤の処理は下の【コード②】を作成しました。それぞれ確認したところ、コード単体としては、①②とも意図した動作をしているのですが、コードを並べると上手く動作しません。色々と試したのですが、上手くいかず、またchatGPTについても無料プランのため、すぐに回答制限となりなかなか進みません。詳しい方アドバイスいただけないでしょうか。

【コード①】

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next ' エラー時に処理を続行
    
    ' B列以外が変更された場合は処理を抜ける
    If Intersect(Target, Me.Columns("B")) Is Nothing Then
        Exit Sub
    End If

    Application.EnableEvents = False ' 再帰処理を防ぐ

    ' 変更されたセルの値を取得し、「業者情報一覧」シートのM2セルに代入
    Dim 変更値 As Variant
    変更値 = Target.Value
    Sheets("業者情報一覧").Range("M2").Value = 変更値

    ' 変更された値が「業者情報一覧」シートのL2セルの値と一致する場合は処理を抜ける
    If 変更値 = Sheets("業者情報一覧").Range("L2").Value Then
        Application.EnableEvents = True
        Exit Sub
    End If

    ' 変更されたセルを選択し、Alt + ↓（オートコンプリート）を実行
    Target.Cells(1, 1).Select
    SendKeys "%{DOWN}" ' Alt + ↓（オートコンプリート）

    ' 【追加】スピル範囲を正しく取得して、プルダウン（入力規則）を明示的に設定
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim listRange As String
    Set ws = Sheets("業者情報一覧")

    ' L2 からのスピル範囲の最終行を取得
    lastRow = ws.Cells(ws.Rows.Count, "L").End(xlUp).Row
    listRange = ws.Name & "!$L$2:$L$" & lastRow ' 正しいリスト範囲を作成

    ' 取得した範囲をリストとして適用
    With Target.Validation
        .Delete ' 既存の入力規則を削除
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
            xlBetween, Formula1:="=" & listRange
        .IgnoreBlank = True
        .InCellDropdown = True
    End With

    Application.EnableEvents = True ' イベント処理を再開
    On Error GoTo 0 ' エラー処理をリセット
End Sub

【コード②】
' セル選択が変わったときに、B列の元の入力規則を解除する

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Static 前回のセル As Range ' 直前に選択していたセルを保持

    ' **B列のセルが変更された場合は、移動時に入力規則を削除**
    If Not 前回のセル Is Nothing Then
        If Not Intersect(前回のセル, Me.Columns("B")) Is Nothing Then
            前回のセル.Validation.Delete ' B列の元の入力規則を削除
        End If
    End If

    ' 今回のセルを前回のセルとして保存
    Set 前回のセル = Target
End Sub

投稿者 : 初心者     投稿日時 : 2025/03/04(Tue) 11:26:34

---

B列の選択したセルを自動で入力規制を解除するコードを、コード①の前に配置して解決しました。
お騒がせしました。