ここから本文です

エクセル VBAにて詳し方、ご教授をお願い致します。 内容としましては、Sheet1のA...

ask********さん

2019/10/1610:51:48

エクセル VBAにて詳し方、ご教授をお願い致します。
内容としましては、Sheet1のA3から値が入っており、検索値はSheet2のD2から入っております。

そこでSheet1のA列の値とSheet2のD列の値が一致したらSheet2に入っている別列の値をSheet1に返したいです。
Sheet2のD列値は重複があったりなかったりします。。
値を返す条件としてはSheet1のA列の値とSheet2のD列の値が一致しSheet2のA列の値が一回目の一致と違った場合にはSheet1の返す行に一行挿入して入れてきたいです。
一致する値が一つの場合はその一つを返す。
返す値はs1のBはs2のA、s1のCはs2のB、s1のDはs2のE、s1のEはs2のF、s1のFはs2のG、以降はs1G/S2H、s1H/s2I~s1AL/s2AMとなります。
照合させるデータは10万×10万ほどありますのでより高速で処理を行いたいです。
難しいですが宜しくお願い致します。

閲覧数:
47
回答数:
1
お礼:
50枚

違反報告

ベストアンサーに選ばれた回答

yuzumiさん

2019/10/1613:53:22

シート1ではなく新しいシートを作って表を書くようにしています。
A列とD列に結果を書きますが、他の列にしたいときは
sht3.Cells(irow3, "D") = buf(ibuf)
の"D"を書き換えてください。


Sub Sheet1のA列の値とSheet2のD列の値が一致したらSheet2に入っている別列の値をSheet1に返したい()
Dim Sht1 As Variant, irow1 As Long
Dim Sht2 As Variant, irow2 As Long, wordD As Variant, wordA As Variant
Dim sht3 As Variant, irow3 As Long
Dim DicSht2 As Variant
Dim buf As Variant, ibuf As Long

Set DicSht2 = CreateObject("Scripting.Dictionary")
Set Sht1 = Sheets("Sheet1")
Set Sht2 = Sheets("Sheet2")

With Sht2
For irow2 = 2 To .Cells(Rows.Count, "D").End(xlUp).Row
wordD = .Cells(irow2, "D").Value
wordA = .Cells(irow2, "A").Value
If DicSht2.Exists(wordD) = True Then
If InStr(DicSht2.Item(wordD), wordA & vbCrLf) = 0 Then
DicSht2.Item(wordD) = DicSht2.Item(wordD) & wordA & vbCrLf
End If
Else
DicSht2.Add wordD, wordA & vbCrLf
End If
Next irow2
End With

Set sht3 = Sheets.Add
irow3 = 3
With Sht1
For irow1 = 3 To .Cells(Rows.Count, "A").End(xlUp).Row
wordD = .Cells(irow1, "A")
sht3.Cells(irow3, "A") = wordD
If DicSht2.Exists(wordD) = True Then
buf = DicSht2(wordD)
buf = Split(buf, vbCrLf)
For ibuf = 0 To UBound(buf) - 1 '最後の1個は空
sht3.Cells(irow3, "D") = buf(ibuf)
irow3 = irow3 + 1
Next ibuf
Else
irow3 = irow3 + 1
End If
Next irow1
End With

Set DicSht2 = Nothing
Set Sht1 = Nothing
Set Sht2 = Nothing
Set sht3 = Nothing
End Sub

返信を取り消しますが
よろしいですか?

  • 取り消す
  • キャンセル

質問した人からのコメント

2019/10/18 09:52:24

大変お世話になりました。
有難うございました。

この質問につけられたタグ

みんなで作る知恵袋 悩みや疑問、なんでも気軽にきいちゃおう!

Q&Aをキーワードで検索:

Yahoo! JAPANは、回答に記載された内容の信ぴょう性、正確性を保証しておりません。
お客様自身の責任と判断で、ご利用ください。
本文はここまでです このページの先頭へ

「追加する」ボタンを押してください。

閉じる

※知恵コレクションに追加された質問は選択されたID/ニックネームのMy知恵袋で確認できます。

不適切な投稿でないことを報告しました。

閉じる