Excelの２個の条件に合致した数値を入力

質問

B.xlsのA列とA.xlsのB列、B.xlsのC列とA.xlsのD列の行がマッチしたらA.xlsのF列、H列の数値をB.xlsのD,E列に添付の下図のように数値を入力したいのですがVBAコードが解る方宜しくお願いします。（同じく関数の方もわかればお願いします）

回答No.1

oyk3865b3702d3r · ベストアンサー

こんにちは

早速ですが、VBAの方で、提案をさせていただきたいと思います。

今回は、まずA/B共に、Sheet1の内容であると仮定して。
また、Bと一致する内容の行が、Aには1行しかないことを仮定して
以下のコードを提案させていただきます。
++++++++++
Option Explicit

Sub VBAでの_Bへの数値を入力()
'A.xlsおよびB.xlsは、共にすでに開いてあるものとする。
Dim wkX As Object '探索ループ用
Dim wkA As Workbook, wkB As Workbook 'A/Bワークブックの格納
For Each wkX In Application.Workbooks '各ワークブックの探索
If wkX.Name = "A.xls" Then 'A.xls発見時
Set wkA = wkX
ElseIf wkX.Name = "B.xls" Then
Set wkB = wkX
End If
Next
'解放
Set wkX = Nothing

'★仮に、A/B共にSheet1にデータがあるとする。
Dim shA As Worksheet, shB As Worksheet
Set shA = wkA.Worksheets("Sheet1")
Set shB = wkB.Worksheets("Sheet1")

Dim i As Long
For i = 2 To shB.Cells(Rows.Count, 3).End(xlUp).Row
'B.xlsの2行目から下にC列終端までループ

Dim k As Long
For k = 2 To shA.Cells(Rows.Count, 2).End(xlUp).Row
'A.xlsの2行目から下にB列終端までループ
'B.xlsのA列(1列目)とA.xlsのB列(2列目)、
If Val(shB.Cells((((i - 2) \ 3) * 3) + 2, 1).Value) = _
Val(shA.Cells(k, 2).Value) Then
'■↑B.xlsのA列には、3行ごと飛び飛びでデータがあるものとする。

'B.xlsのC列(3列目)とA.xlsのD列(4列目)の行が一致したら
If shB.Cells(i, 3).Value = shA.Cells(k, 4).Value Then
'A.xlsのF列(6列目)、H列(8列目)の数値を
'B.xlsのD(4列目),E列(5列目)に数値を入力
shB.Cells(i, 4).Value = shA.Cells(k, 6).Value
shB.Cells(i, 5).Value = shA.Cells(k, 8).Value
Exit For
End If
End If
DoEvents
Next k
Next i
'解放
Set shA = Nothing
Set shB = Nothing
Set wkA = Nothing
Set wkB = Nothing

MsgBox "END"
End Sub

++++++++++
尚、上記のコードは、
取り急ぎ作成したものなので、解放など不十分な点がございます。
また、Excel2013において記述しておりますので、
ほかのバージョンでの動作不良は、ご容赦ください。

以上
ありがとうございました。

お礼

ありがとうございます。非常に勉強になりました。