| |
>その行がtextbox等で1行目とか3行目とか指定された場合に、
>その指定された配列から同じように探索するには、
>”探索範囲の先頭セル”下記の部分を変更すればいいのでしょうか？
>Cellsのセルが変化するということですよね？
>また、表から探索するとなると範囲も定義づけが必要となるのでしょうか？
>
>> '探索範囲の先頭セル位置を指定
>> With ActiveSheet.Cells(1, "A")
>> '列数を取得
>> lngColumns = .Offset(, 256 - .Column).End(xlToLeft).Column - .Column + 1
基本的には、其の通りだと思います
ただ、「表から探索するとなると範囲も定義づけが必要となるのでしょうか？」の意味が解りません
表の最終列は、コードで取得しているので特に何かする必要は無いと思います
今回、数表の行を選択すると言う事なので、前回のコードを少し変更して見ました
変更点は、数表の行を選択する為、ComboBox1を追加しています
ComboBox1には、数表の先頭初期値を表示します
また、変更、追加しているプロシージャは、「Sub UserForm_Initialize()」、
「Sub UserForm_Terminate」、「Sub ComboBox1_Change()」
変数は、「Private rngListTop As Range」が追加されています
「Sub TextBox1_BeforeUpdate」と「Function ColumnSearh」の変更は、有りません
尚、前回は、ActiveSheetに数表が有る様に書きましたが、
今回は、Sheet1に数表が有る様に直していますので気を就けて下さい
また、数表の各行の列数は、違っていても構いません（最終列はコードで取得）
Option Explicit
Private rngListTop As Range
Private rngScope As Range
Private Sub ComboBox1_Change()
Dim lngRow As Long
Dim lngColumns As Long
With ComboBox1
'ComboBoxで有効な行が選択された場合
If .ListIndex > -1 Then
'ListIndexの値を保存
'ListIndexの値と数表の行Offset値は等しい為
lngRow = .ListIndex
Else
Exit Sub
End If
End With
With rngListTop
'列数を取得
lngColumns = .Offset(lngRow, 256 - .Column).End(xlToLeft).Column - .Column + 1
'この部分（以下4行）は、数表が有れば必要ないかも？
If lngColumns <= 1 And .Value = "" Then
MsgBox "参照データが有りません"
Exit Sub
End If
'探索範囲を変数に代入
Set rngScope = .Offset(lngRow).Resize(, lngColumns)
End With
TextBox1.Text = ""
TextBox2.Text = ""
End Sub
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 lngRows As Long
Dim vntData As Variant
'探索範囲の先頭セル位置を指定
Set rngListTop = Worksheets("Sheet1").Cells(1, "A")
'ComboBoxのListを取得
With rngListTop
lngRows = .Offset(65536 - .Row).End(xlUp).Row - .Row + 1
If lngRows <= 1 And .Value = "" Then
MsgBox "参照データが有りません"
Exit Sub
End If
vntData = .Resize(lngRows).Value
End With
'ComboBoxを設定
With ComboBox1
.List = vntData
.Style = fmStyleDropDownList
.ListIndex = 0
End With
End Sub
Private Sub UserForm_Terminate()
Set rngListTop = Nothing
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/9/1(木) 20:46 -
