| |
リョウ さん、こんにちは。
>「商品番号と部品番号を入力すると単価を表示する表」をVBAで作っています。
>・ワークシートのA列に商品番号、B列に部品番号が入っており、C列に単価を
>表示したいと考えています。
>・同じワークシート内に参照先（H列〜J列）があり、H列に商品番号、I列に番号、
>J列にサイズが書かれています。
>a. A列に入力された商品番号が表のH列に無かった場合→C列に「再確認」と表示
検索を使うと楽かも。
>b. A列に入力された商品番号が表のH列にあった場合→その右セル(I列)に書かれた部品番号がB列と一致するかどうか判断。
こっちは比較でよいかも。
> △B列とI列が一致した場合で、J列が"大"の場合はC列に1000を表示。
> ▲B列とI列が一致した場合で、J列が"小"の場合はC列に500を表示。
> ▽B列とI列が一致しなかった場合は、C列に「サイズを選択」と表示
完全一致検索を記録して、分岐を入れるとこんな感じです。
Sub test()
Dim r1 As Range, v1 As Variant, a1 As String, Rmax As Long, ws As Worksheet
'現在表示しているシートが対象です。
Set ws = Application.ActiveSheet
'A列の一番下
With ws.UsedRange
Rmax = ws.Cells(.Cells(.Count).Row + 1, "A").End(xlUp).Row
End With
'２行目から繰り返す(1行目が見出しとして)
For II = 2 To Rmax
With ws
v1 = Chr(0) '変数初期化
Set r1 = .Columns("H").Find(.Cells(II, "A").Value, LookAt:=xlWhole)
'検索結果から分岐
If r1 Is Nothing Then
v1 = "再確認" 'ヒットせず
Else
a1 = r1.Address '最初に見つかった位置を憶えておくため
Do
If .Cells(II, "B").Value = r1.Offset(0, 1).Value Then
'AB一致でJの分岐 （疑問）単価は固定なのですか？
Select Case r1.Offset(0, 2).Value
Case "大": v1 = 1000
Case "小": v1 = 500
Case Else: v1 = "大小不明"
End Select
'ループ脱出
Exit Do
End If
'同じ条件で繰り返す
Set r1 = .Columns("H").FindNext(r1)
Loop While Not r1 Is Nothing And r1.Address <> a1
'Bが一致しないまま検索終了
If v1 = Chr(0) Then v1 = "サイズを選択" '（疑問）商品番号では？
End If
'結果
.Cells(II, "C").Value = v1
End With
Next
'おわり
Set r1 = Nothing: Set ws = Nothing
End Sub
フィルタとかDictionaryの方が速そうですが、件数があまり多くないならこれくらいでも処理の遅さは気にならないかなと。
|
|
りん
- 11/2/17(木) 12:24 -
