エクセル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 SubSub デモ(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