| |
色々と誤解が有るとまずいので整理します
例えば、以下の様な数表とします
sheet3上に表を作成
Ａ Ｂ Ｃ Ｄ Ｅ Ｆ
１
２ あ い う え お
３ イ 100 120 140 160 180
４ ロ 110 140 160 180 200
５ ハ 120 160 180 200 220
６ 二 130 180 200 220 240
７ ホ 140 200 220 240 260
８
A列3行目から下に、行見出し（イロハ・・）が有るとします
2行目、B2:F2に列見出し（あいう・・）が有るとします
数表のデータは、B3を先頭とします
次にUserFormの構成は、以下の様に成ります
ComboBox1 ： 行見出しイロハ・・を表示し数表の行を指定
TextBox1 ： 探索値を指定
TextBox2 ： 探索結果を表示（例、ロ行、141の時、160を表示）
TextBox3 ： 探索結果の有る列見だしを表示（例、ロ行、141の時、「う」）
TextBox4 ： 探索結果の有る列位置を表示（例、ロ行、141の時、「D」）
UserFormのコードは以下の様に成ります
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 = ""
TextBox3.Text = ""
TextBox4.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
'探索結果を表示（例、ロ行、141の時、160を表示）
TextBox2.Text = rngScope(, lngOver).Value
'探索結果の有る列見だしを表示（例、ロ行、141の時、「う」）
TextBox3.Text = rngListTop.Offset(-1, lngOver - 1).Value
'探索結果の有る列位置を表示（例、ロ行、141の時、「D列」）
TextBox4.Text = GetColumnChr(rngListTop.Column + lngOver - 1) & "列"
'範囲から外れる場合
Else
Beep
MsgBox "参照値の範囲を超えています"
Cancel = True
End If
'探索が成功した場合
Else
'探索結果を表示 (例､ロ行､141の時､160を表示)
TextBox2.Text = rngScope(, lngFound).Value
'探索結果の有る列見だしを表示（例、ロ行、141の時、「う」）
TextBox3.Text = rngListTop.Offset(-1, lngFound - 1).Value
'探索結果の有る列位置を表示（例、ロ行、141の時、「D列」）
TextBox4.Text = GetColumnChr(rngListTop.Column + lngFound - 1) & "列"
End If
End If
End With
End Sub
Private Sub UserForm_Initialize()
Dim lngRows As Long
Dim vntData As Variant
'探索範囲の先頭セル位置を指定（Sheet3のB3を指定）
Set rngListTop = Worksheets("Sheet3").Cells(3, "B")
'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 = .Offset(, -1).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
Private Function GetColumnChr(lngMark As Long) As String
Const clngAlphabet As Long = 26
Dim lngNumb As Long
Dim strColumn As String
lngNumb = (lngMark - 1) \ clngAlphabet
If lngNumb > 0 Then
strColumn = Chr(64 + lngNumb)
End If
lngNumb = (lngMark - 1) Mod clngAlphabet
GetColumnChr = strColumn & Chr(65 + lngNumb)
End Function
|
|
Hirofumi
- 05/9/2(金) 22:21 -
