|
こんばんは
一部修正も有ります。
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
'品名コード、重量検索時用の変数
Dim hRng As Range
Dim col As Variant
With Target
'変更セルが複数の場合終了
If .Count > 1 Then Exit Sub
'変更セルがA2、C2以外の場合終了
If Intersect(.Cells, Range("A2,C2")) Is Nothing Then Exit Sub
'A2、C2のどちらかが空の場合終了
If IsEmpty(Range("A2").Value) Or _
IsEmpty(Range("C2").Value) Then
Exit Sub
End If
With Worksheets("Sheet2")
'品名コードでSheet2のA列のデータ範囲を検索
Set hRng = .Range("A2", .Range("A65536").End(xlUp)).Find( _
Range("A2").Value, , xlFormulas, xlWhole)
'品名コードが無かったら終了
If hRng Is Nothing Then
MsgBox "品名コード該当無し。", 64
Exit Sub
End If
'Sheet2の1行目の重量が昇順に並んでいるとして
'C2で指定した重量以下の最大値の入っている列番を取得
col = Application.Match(Range("C2").Value, .Rows(1), 1)
'イベントの発生を抑制
Application.EnableEvents = False
'C2で指定した重量が最小値以下のエラー対応
If IsError(col) Then col = 1
'C2で指定した重量がSheet2の1行目の重量に一致した場合の対応
If .Cells(1, col).Value <> Range("C2").Value Then
Range("D2").Value = hRng.Offset(, col).Value
Else
Range("D2").Value = hRng.Offset(, col - 1).Value
End If
'イベント発生の抑制解除
Application.EnableEvents = True
End With
End With
End Sub
|
|