|
B1セルをダブルクリックしたとき、そこへフォームツールバーの
コンボボックスを配置し、身長を選択できるようにするなら
[シートモジュール]
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _
Cancel As Boolean)
Dim Lp As Single, Wp As Single, Hp As Single
Dim i As Integer
With Target
If .Address <> "$B$1" Then Exit Sub
Lp = .Left: Wp = .Width: Hp = .Height
End With
Cancel = True: Rows.Hidden = False
With ActiveSheet.DropDowns.Add(Lp, 0, Wp, Hp)
For i = 100 To 250 Step 10
.AddItem CStr(i)
Next i
.OnAction = "MyBorder"
End With
End Sub
[標準モジュール]
Sub MyBorder()
Dim Num1 As Integer, Num2 As Integer
If VarType(Application.Caller) <> 8 Then Exit Sub
With ActiveSheet.DropDowns(1)
Num1 = CInt(.List(.ListIndex)) - 30
Num2 = CInt(.List(.ListIndex)) + 30
.Delete
End With
On Error Resume Next
With Range("B2", Range("B65536").End(xlUp)).Offset(, 1)
.Formula = "=IF(AND($B2>=" & Num1 & ",$B2<=" & Num2 & "),"""",1)"
.SpecialCells(3, 1).EntireRow.Hidden = True
.ClearContents
End With
End Sub
|
|