プロが教えるわが家の防犯対策術!

いつも大変お世話になっております。

VBAについてご教示ください。

現在、手元にSheet1のデータがあります。
下記の条件の下、Sheet1のD2:D4のデータ(即ち、Sharesのデータ)をSheet2に自動的に反映させたいのですが、その時どのようなVBAコードで可能となるかご教示ください。
Sheet1の状況およびVBA作業後のSheet2は下の画像をご覧ください。

条件:
1) Sheet1はダウンロードした数値・情報で、特定のセルを手作業で動かすなどこのシート上のマニュアル操作はないものとします。
2) 現在のSheet1ではSheet2に反映するのは3セルだけですが、この数は変動するものとします。(つまり、現在はRow1-3のみですが、Row1-50など数が多くなる場合もSheet2に反映されるようにしたいのです。)
3) Sheet2のAAA,BBBなどの名前は入力されていますが、必ずしもSheet1の名前と一致しません。名前の最初の方は一致するものとします。(例えば、Sheet1ではAAA PLCとありますが、Sheet2ではAAAと表示されています。)また、Sheet2では必ずしも名前がアルファベット順になっているとは限りません。
4) 緑に網掛けする必要はありません。画像ではお伝えしやすく緑の網掛けにしています。

初心者の質問で大変申し訳ございませんが、お力をお貸しください。
どうぞよろしくお願い申し上げます。

「複数条件下のVBAコードをご教示ください」の質問画像

A 回答 (1件)

Sub Macro1()



Dim rng1 As Range
Dim rng2 As Range
Dim cData As Range
Dim c As Range
Dim num As Variant

'シート1の検索範囲設定
Set rng1 = Worksheets("Sheet1").Cells(2, "B")
Set c = rng1.Offset(1, 0)
Do While c.Offset(0, -1).Value = c.Offset(-1, -1).Value + 1
Set rng1 = Union(rng1, c)
Set c = c.Offset(1, 0)
Loop

'シート2の検索範囲設定
Set cData = Worksheets("Sheet2").Cells(5, "B")
Set rng2 = Range(cData, cData.End(xlDown))
'シート2古いデータをクリア
Range(cData.Offset(0, 1), cData.Offset(0, 1).End(xlDown)).ClearContents

'検索
For Each c In rng2
num = Application.Match(c.Value & "*", rng1, 0)
If IsNumeric(num) Then
c.Offset(0, 1).Value = rng1(num).Offset(0, 2).Value
End If
Next

End Sub

教示とは名ばかりの依頼だけですね。あなたは初心者ですらない。
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!