別ブック2列がマッチした文字を入力する

質問

BブックのC列7行目から文字（15ステップ毎文字が入替る）がまたF列8行目からは年月（2017/4～2018/3）、AブックのA列4行目から年月がまたB列4行目からは文字が添付のように連続して入力されています。BブックC列文字とAブックB列文字が一致、BブックF列年月とAブックA列年月が両方一致した行のAブックC列の文字をBブックのE列に順々に入力していきたいのですが。
どなたかVBAコードが解る方ご教授願います。
環境はwindows7 office2013です。

回答No.3

bunjii · ベストアンサー

>検索して両方の文字一致がない場合は空白です。
検索条件のどちらか一方が一致しないときはB.xlsのSheet1のE列はブランク（未入力）となるようにすれば良いということですよね？

>レベルは２で現在勉強中で試行錯誤してます。
VBAのコードはプログラムなので処理したい作業をフローチャートへ書き出すようにすれば考え易くなります。
今回の処理内容はブック名がA.xlsの4行目のA、B、C列の値からブック名がB.xlsのC列がA.xlsのSheet1のB列と同じ値で、然も、B.xlsのSheet1のF列がA.xlsのSheet1のA列と一致するB.xlsのSheet1の行番号のE列へA.xlsのSheet1のC列の値を列記すれば良い訳でチェックする値はA.xlsのSheet1の4行目から下へ順次読み込んでB.xlsのSheet1の何行目が書き込み対象行かを調べる方法で良いでしょう。
当方で検証した結果では以下のコードで目的に合うと思います。
解説が必要な個所は補足で追加質問してください。
Sub Sample1()
Dim i As Long, tmp As String
On Error Resume Next
Max = Workbooks("A.xls").Worksheets("Sheet1").Range("B4").End(xlDown).Row
For i = 4 To Max
m = Application.WorksheetFunction.Match(Workbooks("A.xls").Worksheets("Sheet1").Range("B" & i), Range("C:C"), 0)
j = Application.WorksheetFunction.Match(Workbooks("A.xls").Worksheets("Sheet1").Range("A" & i), Range("F" & m + 1 & ":F" & m + 14), 1)
If Application.WorksheetFunction.CountIf(Range("F" & m + 1 & ":F" & m + 14), Workbooks("A.xls").Worksheets("Sheet1").Range("A" & i)) > 0 Then
buf = Workbooks("A.xls").Worksheets("Sheet1").Range("C" & i).Value
If InStr(Range("E" & m + j), buf) = 0 Then
Range("E" & m + j) = Trim(Range("E" & m + j) & " " & buf)
Range("E" & m + j) = Replace(Trim(Range("E" & m + j)), " ", ",")
End If
End If
Next i
On Error GoTo 0
End Sub

お礼

ありがとうございます。思い通りの処理が出来ました。コード解読を勉強して実践に応用します。

回答No.2

bunjii

>BブックのC列7行目から文字（15ステップ毎文字が入替る）が
「15ステップ毎」は「15行毎」の方が理解し易いと思います。
C7:C21が同じ文字列になっているのですよね？
C22:C36が同じ文字列で、C37:C51も同じ文字列ということですね？
それ以降は何処まで続きますか？

>がまたF列8行目からは年月（2017/4～2018/3）、
日付のシリアル値で毎年の4月から翌年の3月までのようですが毎月の日にちは何日ですか？
例えば、毎月の1日や末日、または15日や20日などの毎月の締め切り日など特定の日でしょうか？

>AブックのA列4行目から年月が
Bブックの日付と関係しますので表示が年月だけであっても日にちも情報として必要になります。

>B列4行目からは文字が添付のように連続して入力されています。
BブックのC列に必ず同じ文字列がありますか？、BブックのC列を検索したとき見つからないときはどのような措置にすれば良いですか？

>どなたかVBAコードが解る方ご教授願います。
あなたの知識レベルはどの程度ですか？
1.初心者で入門書を読んでも理解できない。
2.Excelのワークシート関数やVBA関数は知っていて使い方がよく分からない。
3.フローチャートは書けるがコード化ができない。
4.同一ブック内の処理についてはコード化できる。
5.今回のような対象がブロック化しているデータの処理方法が分からない。
上記の1.または2.のレベルではコードを丸写しで示さないとできないと思います。
3.、4.、5.であれば方法論で理解できるでしょう。
どれがご希望ですか？

お礼

回答ありがとうございます。BブックのC列は300行まで続きます。年月は毎月1日です。検索して両方の文字一致がない場合は空白です。レベルは２で現在勉強中で試行錯誤してます。宜しくお願いします。

回答No.1

mt2015

BookBの標準モジュールに以下のコードを入れてください。
BookAを開いた状態で実行します。

Sub Sample()
　　Dim DicA
　　Set DicA = CreateObject("Scripting.Dictionary")
　　On Error Resume Next
　　'BookAの情報をDictionaryに格納
　　With Workbooks("BookA.xlsx").Sheets("Sheet1")
　　　　For i = 4 To .Range("A4").End(xlDown).Row
　　　　　　'Keyは、BookAのB列の値_A列の値
　　　　　　sKey = .Cells(i, 2) & "_" & Format(.Cells(i, 1), "YYYYMM")
　　　　　　'同じキーのデータをスペース区切りで連結して格納
　　　　　　sDat = Trim(DicA(sKey) & " " & .Cells(i, 3))
　　　　　　DicA(sKey) = sDat
　　　　Next i
　　End With

　　'BookBのE列に該当するデータを入れる
　　For j = 8 To Cells(Rows.Count, 6).End(xlUp).Row
　　　　'Keyが存在しない場合、Empty値
　　　　sGet = DicA(Cells(j, 3) & "_" & Format(Cells(j, 6), "YYYYMM"))
　　　　Cells(j, 5) = sGet
　　Next j
End Sub

お礼

ありがとうございます。