【ノーコード】VBAコードを作成する無料アプリ

AIで自分の価値を高める方法とは🙄

MENU

【ノーコードVBA】セル範囲を参照する入力用ドロップダウンリスト

エクセルVBAマクロを自動作成する無料アプリです。

例として「セル範囲を参照する入力用ドロップダウンリスト」を作成するVBAマクロを作成します。

事例 入力用のドロップダウンリストを作る

 

アプリへのリンク

アプリへのリンク
 ⇒セルの選択で、ドロップダウンリストを開く

 

アプリの画面

作成されたコード

アプリで作成したコードを、VBE画面に貼り付けて実行します。

 

 

セルをクリックするだけで、ドロップダウンリストが開きます。

 

ポイント
作成されたコードは標準モジュールではなく、
   対象のシートのシートモジュールに貼り付けます

できました😊

 

VBAコードを見る

 

 
'【重要】下のコードは、標準モジュールではなく、対象のシートのシートモジュールに貼り付けます
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Intersect(Target, Range("b2:b10")) Is Nothing Then Exit Sub
    Call デモ(Target)
    SendKeys "%{DOWN}"
End Sub

Sub デモ(Target As Range)
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual
    With Sheets("Sheet1")
        Dim lastRow As Long, currentColumn As Long
        currentColumn = Range("g2").Column + Target.Column - Range("b2:b10").Cells(1, 1).Column
        lastRow = .Cells(Rows.Count, currentColumn).End(xlUp).Row
        Dim dict As Object, myRow As Long
        Set dict = CreateObject("Scripting.Dictionary")
        For myRow = Range("g2").Row To lastRow
            If Not .Cells(myRow, currentColumn).EntireRow.Hidden Then
                If Not dict.Exists(.Cells(myRow, currentColumn).Value) Then
                    dict.Add .Cells(myRow, currentColumn).Value, ""
                End If
            End If
        Next myRow
        Dim list As Variant
        list = dict.keys
        If UBound(list) < 0 Then
            MsgBox "元データの範囲に値がありません"
            Exit Sub
        End If
        With Target.Validation
            .Delete
            .Add Type:=xlValidateList, Formula1:=Join(list, ",")
        End With
        Set dict = Nothing
    End With
    Worksheets("Sheet1").Activate
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub