ExcelVBA 入力規則のリストを追加するコード

kokodane.com

作った後に念のために～と検索してみると，マクロ使わなくてもこれでいいじゃないかと　思えなくもない記事に出会いましたが，

コード表を違うシートに作っていて，そちらにいちいち行きたくはない，知らない人にそこを不用意にいじられたくない，

という欲求をもって作業ファイルを私は作ります。結構想定外のことは多いですから・・ヒトは思い通りにはいかない。。

そこで，コードである程度制御してみたいと思い作ってみました。

validationというプロパティを知りませんでしたので，こちらを参考にさせていただきました。
www.relief.jp

Sheet1に，下記のようにデータを入力するところがあります。黄色い部分に入力を行いますが，そこには入力規則が入っており，リストというシートのセルから値リストを作成している感じです。
リストに無い値は怒られるわけですが，Sheet1のセルD2に追加したい値を入れるとリストの項目をVBAで追加し，その後リストの値として利用できます，という仕組みを想定してみました。

　　　

コードはこちら。Worksheetのchangeイベントに書き込みます。

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$D$2" And Target.Value <> "" Then
        Dim 入力規則セル As Range: Set 入力規則セル = Worksheets("Sheet1").Range("a2")
        Dim listWorksheet As Worksheet
        Dim cellList As Range
        Dim cellVaridation As Range
        Dim validationFormula1 As String: validationFormula1 = 入力規則セル.Validation.Formula1
        
        Set listWorksheet = Worksheets(Mid(validationFormula1, 2, InStr(validationFormula1, "!") - 2))
        Set cellList = listWorksheet.Range(Mid(validationFormula1, InStr(validationFormula1, "!") + 1))
         
        Dim c As Range
        
        For Each c In cellList
            If c.Value = Target.Value Then Exit Sub
        Next
        
        If MsgBox(Target.Value & "を本当にリスト項目に追加しますか?", vbOKCancel) = vbCancel Then Exit Sub
        
        cellList.Resize(1).Offset(cellList.Rows.Count).Value = Target.Value
        
        For Each c In 入力規則セル.EntireColumn.SpecialCells(xlCellTypeAllValidation)
            If c.Validation.Type = xlValidateList Then
                c.Validation.Delete
                c.Validation.Add xlValidateList, Formula1:="=リスト!" & cellList.Resize(cellList.Rows.Count + 1).Address
            End If
        Next
    End If
End Sub

Target.Addressの中身は$を付けた絶対参照で環境に合わせてください。
入力規則が入っているセルもその列のどれかのセルを指定してください。EntireColumnで，列全体を指定しなおして，入力規則がリスト設定となっているところを全部書き換えてしまいます。
利用は自己責任&注意してお使いください。

イレギュラーは全く想定されていないので，利用可能な方がどのくらいいるのかわかりませんが，上記　二ヶ所を書き換えればいちおう使えるのかなーという感じです。