|
こんにちは。
先々週?作った奴、InputBoxじゃないけど...。
つんさんにあげる。
Sub 許可テスト飛び飛びOK()
Dim 許可範囲 As Range, 選択範囲 As Range, Flg As Boolean
'Set 許可範囲 = Columns(3).Resize(, 3) 'OK
Set 許可範囲 = Range("C3:E5").EntireColumn 'OK
'Set 許可範囲 = Columns("C:E") 'OK
'Set 許可範囲 = Rows(3).Resize(3) 'OK
'Set 許可範囲 = Range("B2:E10") 'OK
For Each 選択範囲 In Selection.Areas
If 選択許可範囲内か(許可範囲, 選択範囲) = False Then
Flg = True
Exit For
End If
Next
If Flg Then
MsgBox "選択されたセルは、許可範囲 " & 許可範囲.Address(0, 0) & _
" から、外れている物があります。"
Else
MsgBox "選択されたセルは、許可範囲 " & 許可範囲.Address(0, 0) & _
" 内に全て入ってます。"
End If
Set 許可範囲 = Nothing
End Sub
Function 選択許可範囲内か(許可範囲 As Range, 選択範囲 As Range) As Boolean
Dim 許可行上 As Long, 許可行下 As Long, 許可左列 As Long, 許可右列 As Long
Dim 選択行上 As Long, 選択行下 As Long, 選択左列 As Long, 選択右列 As Long
If Application.Intersect(選択範囲, 許可範囲) Is Nothing Then
選択許可範囲内か = False
Exit Function
End If
With 許可範囲
許可行上 = .Cells(1).Row
許可行下 = .Cells(.Cells.Count).Row
許可左列 = .Cells(1).Column
許可右列 = .Cells(.Cells.Count).Column
End With
With 選択範囲
選択行上 = .Cells(1).Row
選択行下 = .Cells(.Cells.Count).Row
選択左列 = .Cells(1).Column
選択右列 = .Cells(.Cells.Count).Column
End With
If 許可行上 <= 選択行上 And 許可行下 >= 選択行下 And _
許可左列 <= 選択左列 And 許可右列 >= 選択右列 Then
選択許可範囲内か = True
Else
選択許可範囲内か = False
End If
End Function
|
|