VBA 条件検索について

質問

VBAの検索について質問です。

以下のようなものを作ろうと思います。
sheet1とsheet2がありsheet1のA、Bの数値をsheet2の同じA,Bの数値の値の行を検索して,
その同じ値の行のsheet1のCの数値の値からsheet2のCの数値を引いた値をsheet3のC列に返すプログラムを作ろうと思います。空白などで同じ値がない場合はsheet3に空欄を返そうと思います。
以下に例をプログラムの実行例を示します。
sheet1
■ A 列 B 列 C列
1： 7 | 1 | 3
2： 5 | 8 | 2
3： 2 | 3 | 1
4： 9 | 6 | 4

sheet2
■ A 列 B列 C列
1： 2 | 3 | 4
2： 9 | 6 | 2
3： 7 | １ | 5
4： 5| 　 | 3

sheet3
■ A列 B列 C列
1： 7| 1 | -2
2：
3： 2| 3 | -3
4： 9 | 6 | 2

自分で以下のプログラムを作成してみたのですが空欄が検索できなかったりしてなかなかできません。
どなたか、教えてください。お願いします。

Sub test()

Dim sh1 As Object, sh2 As Object, sh3 As Object
Dim d1 As String, d2 As String, a As Long
Set sh1 =Sheets(“Sheet1”)
Set sh2 =Sheets(“Sheet2”)
Set sh3 =Sheets(“Sheet3”)

For a = 1 To 3000 Step 1
d1 = sh1.Cells(a,1) & sh1.Cells(a,2)
d2 = sh2.Cells(a,1) & sh2.Cells(a,2)
Do while d2 <>””
If d1 = d2 Then
Sh3.Cells(a,1) = sh1.Cells(a,1)
Sh3.Cells(a,2) = sh1.Cells(a,2)
Sh3.Cells(a,3) = sh1.Cells(a,3)
Exit Do
End If
a= a+1
d2 = sh2.Cells(a,1) & sh2.Cells(a,2)
Loop

Next
End Sub

回答No.1

jcctaira · ベストアンサー

mekarattaさん
こんにちは。

下記のプログラムでできるかと思います。

Sub test()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim sh3 As Worksheet
Dim a　 As Long
Dim b　 As Long

Set sh1 = Sheets("Sheet1")
Set sh2 = Sheets("Sheet2")
Set sh3 = Sheets("Sheet3")
a = 1
Do While (sh1.Cells(a, "A") <> "" Or sh1.Cells(a, "B") <> "")
　b = 1
　Do While (sh2.Cells(b, "A") <> "" Or sh2.Cells(b, "B") <> "")
　　If sh1.Cells(a, "A") = sh2.Cells(b, "A") And _
　　　 sh1.Cells(a, "B") = sh2.Cells(b, "B") Then
　　　sh3.Cells(a, "A") = sh1.Cells(a, "A")
　　　sh3.Cells(a, "B") = sh1.Cells(a, "B")
　　　sh3.Cells(a, "C") = sh1.Cells(a, "C") - sh2.Cells(b, "C")
　　　Exit Do
　　End If
　　b = b + 1
　Loop
　a = a + 1
Loop
End Sub

注）d1 = sh1.Cells(a,1) & sh1.Cells(a,2)
　　連結して比較しない方が良いと思います。
　　例えばA1=11 B1=2 と A2=1 B2=12 はどちらも 112 となってしまうので危険です。

ご確認ください。

お礼

ありがとうございます

回答No.2

mu2011

一例です。
シートマクロにしていますので、Sheet3タブ上で右クリック→コードの表示→以下のコードを貼り付けでお試しください。

Sub sample()
Set st1 = Sheets(1)
Set st2 = Sheets(2)
Columns("A:C").Cells.Clear
For i = 1 To st1.UsedRange.Rows.Count
For j = 1 To st2.UsedRange.Rows.Count
If st1.Cells(i, 1) = st2.Cells(j, 1) And _
st1.Cells(i, 2) = st2.Cells(j, 2) Then
Cells(i, 1).Resize(1, 2).Value = st1.Cells(i, 1).Resize(1, 2).Value
Cells(i, 3).Value = st1.Cells(i, 3) - st2.Cells(j, 3)
Exit For
End If
Next
Next
End Sub