| |
>ちなみに、
>>この値がセルＡ１〜Ｆ１にあったとします。
>この部分を検索範囲とし
>
>>検索値は Ａ２
>この部分をTextbox１
>
>>数式を入れるセルをＢ２とすると、
>この部分をTextbox２
>とした場合にマクロとして記述することはできるのでしょうか？
此れがUserFormのTextBoxでと言う事なら以下の様に成ります
以下をUserFormのコードモジュールに記述して下さい
Option Explicit
Private rngScope As Range
Private Sub TextBox1_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
Dim lngFound As Long
Dim lngOver As Long
TextBox2.Text = ""
With TextBox1
If .Text <> "" Then
'探索範囲から、値を探索
lngFound = ColumnSearh(CLng(.Text), rngScope, lngOver)
'探索が失敗した場合（探索値其の物が無い場合）
If lngFound = 0 Then
'探索値を超える最小値のある列が範囲内の場合
If lngOver <= rngScope.Columns.Count Then
TextBox2.Text = rngScope(, lngOver).Value
'範囲から外れる場合
Else
Beep
MsgBox "参照値の範囲を超えています"
Cancel = True
End If
'探索が成功した場合
Else
TextBox2.Text = rngScope(, lngFound).Value
End If
End If
End With
End Sub
Private Sub UserForm_Initialize()
Dim lngColumns As Long
'探索範囲の先頭セル位置を指定
With ActiveSheet.Cells(1, "A")
'列数を取得
lngColumns = .Offset(, 256 - .Column).End(xlToLeft).Column - .Column + 1
If lngColumns <= 1 And .Value = "" Then
MsgBox "参照データが有りません"
Exit Sub
End If
'探索範囲を変数に代入
Set rngScope = .Resize(, lngColumns)
End With
End Sub
Private Sub UserForm_Terminate()
Set rngScope = Nothing
End Sub
Private Function ColumnSearh(vntKey As Variant, _
rngScope As Range, _
Optional lngOver As Long) As Long
Dim vntFound As Variant
'Matchによる二分探索
vntFound = Application.Match(vntKey, rngScope, 1)
'もし、エラーで無いなら
If Not IsError(vntFound) Then
'もし、Key値と探索位置の値が等しいなら
If vntKey = rngScope(, vntFound).Value Then
'戻り値として、列位置を代入
ColumnSearh = vntFound
End If
'Key値を超える最小値のある列
lngOver = vntFound + 1
Else
lngOver = 1
End If
End Function
|
|
Hirofumi
- 05/8/31(水) 21:12 -
