Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


13988 / 76733 ←次へ | 前へ→

【68245】Re:同一ワークシート内の参照先から単価を表示する方法
回答  りん E-MAIL  - 11/2/17(木) 12:24 -

引用なし
パスワード
       リョウ さん、こんにちは。

>「商品番号と部品番号を入力すると単価を表示する表」を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
  '2行目から繰り返す(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の方が速そうですが、件数があまり多くないならこれくらいでも処理の遅さは気にならないかなと。
0 hits

【68234】同一ワークシート内の参照先から単価を表示する方法 リョウ 11/2/17(木) 0:45 質問
【68245】Re:同一ワークシート内の参照先から単価を... りん 11/2/17(木) 12:24 回答
【68250】Re:同一ワークシート内の参照先から単価を... めいぷる 11/2/17(木) 15:19 発言
【68252】Re:同一ワークシート内の参照先から単価を... Yuki 11/2/17(木) 16:18 発言

13988 / 76733 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free