'リストボックスにセルの値を入力するマクロ

'リストボックスまたはドロップダウンを選択して、
'SetListBoxValueマクロを実行してください。

Option Explicit

Sub SetListBoxValue()
    Const myTitle As String = "リストボックスにセルの値を入力"
    Dim range1 As Range, r As Range
    Dim s As String
    Dim ret As Integer

    Select Case TypeName(Selection)
        Case "ListBox", "DropDown"
        Case Else
            MsgBox "リストボックスまたはドロップダウンを選択して" & _
            "実行してください。", vbExclamation, myTitle
            Exit Sub
    End Select

    On Error Resume Next
    Set range1 = Application.InputBox( _
        prompt:="セル範囲を入力してください。", _
        Title:=myTitle, Type:=8)
    On Error GoTo 0
    If range1 Is Nothing Then Exit Sub

    ret = MsgBox("空白値を除きますか?", _
        vbExclamation Or vbYesNoCancel, myTitle)
    If ret = vbCancel Then Exit Sub

    With Selection
        .RemoveAllItems
        If ret = vbYes Then
            For Each r In range1.Cells
                s = r.Text
                If Len(s) > 0 Then .AddItem s
            Next
        Else
            For Each r In range1.Cells
                .AddItem r.Text
            Next
        End If
    End With
End Sub