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

問題　　　　topへ

問題1：Sheet1に商品の単価リストがあります。このリストからSheet2の表を埋めなさい。　　問題1の解答

Sheet1の商品の単価リスト

	B	C	D
2	商品単価リスト
3	コード	商品名	単価
4	101	りんご	250
5	102	みかん	124
6	103	バナナ	213
7	104	パイナップル	457

Sheet2の販売実績：商品名と販売金額を求めなさい。
販売金額は　販売数×単価　で求めることとします。

	B	C	D	E
2	販売実績
3	コード	商品名	販売数	販売金額
4	102		150
5	104		89
6	101		225
7	103		304

問題2：Sheet1に問題1と同じ「商品の単価リスト」があります。このリストからSheet3のコードを求めなさい。　　問題2の解答

	B	C	D
2	販売実績
3	コード	商品名	販売数
4		みかん	150
5		パイナップル	89
6		りんご	225
7		バナナ	304

問題3：Sheet1に判定基準の表があります。この基準でSheet2のD列に得点の判定をしなさい。　　問題3の解答

Sheet1に正式の判定基準の表があります。
0以上40未満は「不可」、40以上60未満は「可」、60以上80未満は「良」、80以上は「優」を意味します。

	B	C	D	E	F
2	判定基準
3	得点(以上)	0	40	60	80
4	判定	不可	可	良	優

Sheet2のD列で判定をしなさい。

	B	C	D
2	名前	得点	判定
3	相沢一郎	52	可
4	井上浩二	74	良
5	上野有紀	84	優
6	内野武	32	不可
7	上田祥子	68	良
8	江田早苗	59	可
9	榎本高貴	80	優
10	小田和樹	60	良

解答例　　　　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

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

上では変数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

検索するリスト（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

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

検索するリスト（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

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	良

質問に対する回答としては不適当ですが、コード内に判定基準を書いて比較しています。
このコードでは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

スポンサードリンク

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

問題 topへ

解答例 topへ

問題1の解答例 topへ

問題2の解答例 topへ

問題3の解答例 topへ

問題　　　　topへ

解答例　　　　topへ

問題1の解答例　　　　 topへ

問題2の解答例　　　　 topへ

問題3の解答例　　　　 topへ