エクセル練習問題:列の検索・行の検索(VBA)


スポンサードリンク

問題    topへ

解答例    topへ

問題1の解答例    topへ


B C D E
2 販売実績
3 コード 商品名 販売数 販売金額
4 102 みかん 150 18,600
5 104 パイナップル 89 40,673
6 101 りんご 225 56,250
7 103 バナナ 304 64,752
  1. Application.VLookupを利用した例です。
    • ワークシート関数VLOOKUPを利用した例です。
      ただし、Application.WorksheetFunction.Vlookupではエラー時に処理が止まりますので、ここではApplication.VLookupを使いました。
    Sub test12()
      Dim myV As Variant
      Dim i As Long
        With Worksheets("Sheet2")
          For i = 4 To 7
            'コードから商品名を求める
            myV = Application.VLookup(.Range("B" & i).Value, Worksheets("Sheet1").Range("B4:D7"), 2, False)
            If IsError(myV) Then
              .Range("C" & i).Value = "該当なし"
            Else
              .Range("C" & i).Value = myV
            End If
            'コードから単価を求める
            myV = Application.VLookup(.Range("B" & i).Value, Worksheets("Sheet1").Range("B4:D7"), 3, False)
            If IsError(myV) Then
              .Range("E" & i).Value = "該当なし"
            Else
               ’↓の計算式が間違っていましたので、2020/4/28に修正しました
              .Range("E" & i).Value = myV * .Range("D" & i).Value
            End If
          Next i
        End With

    End Sub
  2. 上では変数myVを商品名と単価の両方に使っていたのを区別しています。
    また、Rangeを一部Cellsに変更した例です。
    Sub test12a()
     Dim Syohin As Variant
     Dim Tanka As Variant
     Dim i As Long
     Dim Sh1 As Worksheet, Sh2 As Worksheet
      Set Sh1 = Worksheets("Sheet1")
      Set Sh2 = Worksheets("Sheet2")

      With Sh2
       For i = 4 To 7
        'コードから商品名を求める
        Syohin = Application.VLookup(.Cells(i, 2).Value, Sh1.Range(Sh1.Cells(4, 2), Sh1.Cells(7, 4)), 2, False)
        If IsError(Syohin) Then
         .Range("C" & i).Value = "該当なし"
        Else
         .Range("C" & i).Value = Syohin
        End If
        'コードから単価を求める
        Tanka = Application.VLookup(.Cells(i, 2).Value, Sh1.Range(Sh1.Cells(4, 2), Sh1.Cells(7, 4)), 3, False)
        If IsError(Tanka) Then
         .Cells(i, 5).Value = "該当なし"
        Else
         .Cells(i, 5).Value = Tanka * .Cells(i, 4).Value
        End If
       Next i
      End With

    End Sub
  3. 検索するリスト(Sheet1のB4:D7)を配列に読み込み、1件ずつ該当するものを見つけていくコードです。
    • myData = Worksheets("Sheet1").Range("B4:D7").Valueは下図のような位置関係になります。
      B C D
      2 商品単価リスト
      3 コード 商品名 単価
      4 myData(1,1) myData(1,2) myData(1,3)
      5 myData(2,1) myData(2,2) myData(2,3)
      6 myData(3,1) myData(3,2) myData(3,3)
      7 myData(4,1) myData(4,2) myData(4,3)
    Sub test10()
      Dim i As Long, j As Long
      Dim myData As Variant
        myData = Worksheets("Sheet1").Range("B4:D7").Value

        With Worksheets("Sheet2")
          For i = 4 To 7
            For j = LBound(myData, 1) To UBound(myData)
              If .Range("B" & i).Value = myData(j, 1) Then
                .Range("C" & i).Value = myData(j, 2)
                .Range("E" & i).Value = .Range("D" & i).Value * myData(j, 3)
                Exit For
              End If
            Next j
          Next i

          .Range("E4:E7").NumberFormatLocal = "#,##0"

        End With
    End Sub
  4. Findメソッドを利用した例です。
    Sub test11()
      Dim c As Object
      Dim myKey As String
      Dim i As Long
        For i = 4 To 7
          myKey = Worksheets("Sheet2").Range("B" & i).Value
          With Worksheets("Sheet1").Range("B4:B7")
            Set c = .Find(What:=myKey, LookIn:=xlValues, lookat:=xlWhole, _
                 SearchOrder:=xlByColumns, MatchByte:=False)
            If Not c Is Nothing Then
              Worksheets("Sheet2").Range("C" & i).Value = c.Offset(0, 1).Value
              Worksheets("Sheet2").Range("E" & i).Value = Worksheets("Sheet2").Range("D" & i).Value * c.Offset(0, 2).Value
            End If
          End With
        Next i
        Worksheets("Sheet2").Range("E4:E7").NumberFormatLocal = "#,##0"
    End Sub

問題2の解答例    topへ


B C D
2 販売実績
3 コード 商品名 販売数
4 102 みかん 150
5 104 パイナップル 89
6 101 りんご 225
7 103 バナナ 304
  1. 検索するリスト(Sheet1のB4:C7)を配列に読み込み、1件ずつ該当するものを見つけていくコードです。
    Sub test20()
      Dim i As Long, j As Long
      Dim myData As Variant
        myData = Worksheets("Sheet1").Range("B4:C7").Value
        With Worksheets("Sheet3")
          For i = 4 To 7
            For j = LBound(myData, 1) To UBound(myData)
              If .Range("C" & i).Value = myData(j, 2) Then
                .Range("B" & i).Value = myData(j, 1)
                Exit For
              End If
            Next j
          Next i
        End With
    End Sub
  2. Findメソッドを利用した例です。
    Sub test21()
      Dim c As Object
      Dim myKey As String
      Dim i As Long
        For i = 4 To 7
          myKey = Worksheets("Sheet3").Range("C" & i).Value
          With Worksheets("Sheet1").Range("C4:C7")
            Set c = .Find(What:=myKey, LookIn:=xlValues, lookat:=xlWhole, _
                 SearchOrder:=xlByColumns, MatchByte:=False)
            If Not c Is Nothing Then
              Worksheets("Sheet3").Range("B" & i).Value = c.Offset(0, -1).Value
            End If
          End With
        Next i
    End Sub

問題3の解答例    topへ


B C D
2 名前 得点 判定
3 相沢一郎 52
4 井上浩二 74
5 上野有紀 84
6 内野武 32 不可
7 上田祥子 68
8 江田早苗 59
9 榎本高貴 80
10 小田和樹 60
  1. 質問に対する回答としては不適当ですが、コード内に判定基準を書いて比較しています。
    このコードではSheet1を全く参照していません。
    (元の質問はワークシート関数HLOOKUPの使用例のためのものでしたのでご了承ください。)
    Sub test30()
      Dim myRng As Range
      Dim c As Range
      Dim myMark As String
        Set myRng = Range("C3:C10")

        For Each c In myRng
          Select Case c.Value
            Case Is >= 80
              myMark = "優"
            Case Is >= 60
              myMark = "良"
            Case Is >= 40
              myMark = "可"
            Case Is >= 0
              myMark = "不可"
            Case Else
              myMark = ""
          End Select

          c.Offset(0, 1).Value = myMark
        Next c
    End Sub

スポンサードリンク



よねさんのExcelとWordの使い方エクセル練習問題:目次|列の検索・行の検索(VBA)