エクセルVBAマクロを自動作成する無料アプリです。
例として「入力規則のドロップダウンリスト（最新・重複／空白なし）を、セル選択ですぐ開く」VBAマクロを作成します。
事例
できました(^^)/
活用例
・下記のフィルターとともに貼り付けると、フィルタリングが便利になります。
(注意点：それぞれ異なるマクロ名にしてください)
アプリの設定
アプリのトップページ
⇒▼入力規則、メッセージ、自動実行
⇒入力規則のリスト（最新・重複/空白なし）を、セル選択で開く
表示されるVBAコード
アプリで作成されたコードを、VBE画面に貼り付ければ、マクロの完成です。
【重要】最下段のコードは、標準モジュールではなく、対象のシートのシートモジュールに貼り付けます
VBAコードを見る
'【重要】
'【重要】下のコードは、標準モジュールではなく、対象のシートのシートモジュールに貼り付けます
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("B2：F2")) 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 最終行 As Long, 現在列 As Long
現在列 = Range("b5").Column + Target.Column - Range("B2：F2").Cells(1, 1).Column
最終行 = .Cells(Rows.Count, 現在列).End(xlUp).Row
If IsDate(.Cells(Range("b5").Row, 現在列).Value) Then
'日付の場合はセル範囲
With Target.Validation
.Delete
.Add Type:=xlValidateList, Formula1:="=" & "Sheet1" & "!" & Cells(Range("b5").Row, 現在列).Address & ":" & Cells(最終行, 現在列).Address
End With
Else
'日付以外は、辞書に見出し語を登録
Dim 辞書 As Object, 行 As Long
Set 辞書 = CreateObject("Scripting.Dictionary")
For 行 = Range("b5").Row To 最終行
If Not .Cells(行, 現在列).EntireRow.Hidden Then
If Not 辞書.Exists(.Cells(行, 現在列).Value) Then
辞書.Add .Cells(行, 現在列).Value, "1"
End If
End If
Next 行
'見出し語を、リストに入れる
Dim リスト As Variant
リスト = 辞書.keys
'リストを、入力規則にいれる
With Target.Validation
.Delete
.Add Type:=xlValidateList, Formula1:=Join(リスト, ",")
End With
Set 辞書 = Nothing
End If
End With
Worksheets("sheet1").Activate
Application.Calculation = xlCalculationAutomatic ' 自動計算を再開
Application.DisplayAlerts = True ' 警告表示を再開
Application.ScreenUpdating = True ' 画面描画を再開
End Sub
ChatGPTで修正
あなたが自動化したい内容と事例が少し異なる場合は、無料で使えるマイクロソフトの「BingAIチャット」でコードを修正します。とても簡単です！
