vba 入力規制を変更する

■呼び出し元コード

Sub 入力規制変更()
    Dim wb As Workbook
    Dim sh As Worksheet
    Dim str_Range As String
    Dim str_Path As String
    Dim str_ShName As String
    Dim str_Result As String
    
    str_Path = "C:\Users\デスクトップ\テスト1.xlsx"    
    str_ShName = "Sheet1"
        
    Set wb = Workbooks.Open(str_Path)
    Set sh = wb.Sheets(str_ShName)
    
    'C列の入力規制を変更
    str_Result = fncModifyValidation(sh, "C", 3, 2)
    wb.Save
    Debug.Print "C列の入力規制の変更結果:" & str_Result
    
    'E列の入力規制を変更
    str_Result = fncModifyValidation(sh, "E", 3, 2)
    wb.Save
    Debug.Print "E列の入力規制の変更結果:" & str_Result
    
    wb.Close True

End Sub

■呼び出し先コード

Function fncModifyValidation(sh As Worksheet, str_Column As String, int_StartRow As Integer, int_ColumnNum As Integer) As String
'--------------------------------------------
'機能：セルに設定された入力規制を変更する
'引数1：対象ワークシートオブジェクト
'引数2：変更対象の列名
'引数3：入力規制範囲のスタート行
'引数4：表の一番最後まで値の入っている列を指定
        '※最終行の判定に使用
'戻り値：実行結果（OKまたはNG）
'---------------------------------------------
Dim str_Range As String
Dim intRow As Integer
Dim str_copyRange As String

On Error GoTo ErrHandler

Debug.Print "シート名：" & sh.Name
'---------------------------------------------
'前処理：実際に表の先頭からどの行まで入力規制が設定されているか不明の為
'        一旦先頭行より１行下～最終行までの入力規制を削除した後
'　　　　先頭行の入力規制を最終行までコピーした上で変更処理をした方が
'        エラーの発生を制御できる
With sh
    .Select
    '表の最終行を取得
    intRow = Cells(Rows.Count, int_ColumnNum).End(xlUp).Row
    '入力規制範囲の文字列を生成（先頭行+１～最終行まで）
    str_Range = str_Column & CStr(int_StartRow) & ":" & str_Column & CStr(intRow)
    'コピー範囲の文字列を生成（先頭行+１～最終行まで）
    str_copyRange = str_Column & CStr(int_StartRow + 1) & ":" & str_Column & CStr(intRow)
    
    Debug.Print "入力規制範囲　：" & str_Range
    Debug.Print "コピー範囲　　：" & str_copyRange
    '先頭行から下の入力規制を一旦削除
    .Range(str_copyRange).Validation.Delete
    '入力規制の先頭セルをコピー→先頭行以下最終行までコピー
    .Range(str_Column & CStr(int_StartRow)).Copy
    .Range(str_copyRange).PasteSpecial xlPasteValidation
    Application.CutCopyMode = False
End With
'---------------------------------------------
'入力規制の変更：指定された列ごとに指定の値で変更
If str_Column = "C" Then
    With sh.Range(str_Range).Validation
        .Modify Type:=xlValidateList, _
         AlertStyle:=xlValidAlertStop, _
         Formula1:="製品D,製品E,製品F"
    End With
Else
    With sh.Range(str_Range).Validation
        .Modify Type:=xlValidateList, _
         AlertStyle:=xlValidAlertStop, _
         Formula1:="株式会社D,株式会社E,株式会社F"
    End With
End If

fncModifyValidation = "OK"
Exit Function

ErrHandler:
Debug.Print Err.Number & ":" & Err.Description
fncModifyValidation = "NG"

End Function

■参考URL
【VBA】入力規則の設定／削除／変更を行う | 自恃ろぐ-jizilog.com-