| |
VLookupでは有りませんが、こんなのでも出来ますよ？
このコードは、商品コードが昇順で整列している事を想定しています
もし、商品コードが整列されて居ない場合、以下を変更して下さい
lngFound = RowSearchBin(CLng(SNumber.Text), rngCode, 1)
を
lngFound = RowSearchBin(CLng(SNumber.Text), rngCode, 0)
にして下さい
以下をUserFormのコードモジュールに記述して下さい
尚、単価の表示の為、txtTankaと言うTextBoxを想定しています
Option Explicit
Private rngCode As Range
Private Sub SNumber_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
Dim lngFound As Long
Dim vntData As Variant
'もし、データ範囲にデータが有り、SNumberが""で無いなら
If (Not rngCode Is Nothing) And SNumber.Text <> "" Then
'商品コードを探索
'商品コードが数値として入力されている場合
lngFound = RowSearchBin(CLng(SNumber.Text), rngCode, 1)
'商品コードが文字列として入力されている場合
' lngFound = RowSearchBin(SNumber.Text, rngCode, 1)
'商品コードが有った場合
If lngFound > 0 Then
Shouhin.Text = rngCode.Item(lngFound, 2).Value
txtTanka.Text = rngCode.Item(lngFound, 3).Value
Else
Cancel = True
Beep
MsgBox "該当コードが有りません"
Shouhin.Text = ""
txtTanka.Text = ""
End If
End If
End Sub
Private Sub UserForm_Initialize()
Dim lngRows As Long
'商品等のデーターの左上隅を基準とする（列見出しが有る場合）
With Worksheets("Sheet1").Cells(1, "A")
'データ行数を取得
lngRows = .Offset(65536 - .Row).End(xlUp).Row - .Row
If lngRows > 0 Then
'データ範囲を設定
Set rngCode = .Offset(1).Resize(lngRows)
End If
End With
'商品等のデーターの左上隅を基準とする（列見出しが無い場合）
' With Worksheets("Sheet1").Cells(1, "A")
' 'データ行数を取得
' lngRows = .Offset(65536 - .Row).End(xlUp).Row - .Row + 1
' If lngRows >= 1 And .Value <> "" Then
' 'データ範囲を設定
' Set rngCode = .Resize(lngRows)
' End If
' End With
End Sub
Private Sub UserForm_Terminate()
Set rngCode = Nothing
End Sub
Private Function RowSearchBin(vntKey As Variant, _
rngScope As Range, _
Optional lngMode As Long) As Long
Dim vntFound As Variant
'Matchによる二分探索
vntFound = Application.Match(vntKey, rngScope, lngMode)
'もし、エラーで無いなら
If Not IsError(vntFound) Then
'もし、Key値と探索位置の値が等しいなら
If vntKey = rngScope(vntFound).Value Then
'戻り値として、行位置を代入
RowSearchBin = vntFound
End If
End If
End Function
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
