指定列と行が一致するセルの値を別シートセルに入力

質問

sheet1のB3～B10にAからHの文字がありC2～H2に日付9/1～9/6がありC3～H10の枠内に数値が入力されています。sheet2のC3～F7の枠内にB列文字B～H、2行目日付9/1～9/4に一致する数値をsheet1よりボタンで入力したいのですがどなたかVBAが解る方宜しくお願いします。
環境はoffice Excel2013です。

回答No.1

kkkkkm · ベストアンサー

VBAでなくても数式で
Sheet2のC3に
=IFERROR(INDEX(Sheet1!$C$3:$H$10,MATCH($B3,Sheet1!$B$3:$B$10,0),MATCH(C$2,Sheet1!$C$2:$H$2,0)),"")
として下と右にコピーすればいけると思いますがVBAがいいんでしょうか。

回答No.3

HohoPapa

Sheet1のC2:H2とSheet2のC2:H2は、
並びが必ず同じという条件でよければ
次のようなコードでいかがでしょうか？

コード中のF1やF2は
F1がB列、F2がC列、F3がD列のことです。
対象列の数だけ、F2から並べてください。

Sub Sample1()

　Dim SQL As String
　Dim cn As Object
　Dim rs As Object
　Set cn = CreateObject("ADODB.Connection")
　Set rs = CreateObject("ADODB.Recordset")
　cn.Provider = "Microsoft.ACE.OLEDB.12.0"
　cn.Properties("Extended Properties") = "Excel 12.0;HDR=NO;IMEX=1"
　cn.Open ThisWorkbook.FullName

　SQL = ""
　SQL = SQL & "select T2.F2,T2.F3,T2.F4,T2.F5,T2.F6,T2.F7" & vbCrLf
　SQL = SQL & "FROM [Sheet2$B3:B6500] as T1" & vbCrLf
　SQL = SQL & "Left join [Sheet1$B3:Z6500] as T2 on " & vbCrLf
　SQL = SQL & "T2.[F1]=T1.[F1] " & vbCrLf

　rs.Open SQL, cn

　With ThisWorkbook.Worksheets("Sheet2")
　　.Range("C3").CopyFromRecordset rs
　End With

End Sub

お礼

有難うございました。勉強になりました。

回答No.2

kkkkkm

VBAがいい場合
No1の操作の最後にSheet2で式をコピー( 広めにコピーしたほうがいいかも)した範囲を選択してコピーしその場で値貼り付けを追加した操作をマクロで記録してそのコードをボタンに割り付けてください。

お礼

有難うございました。