エクセルでデータ抽出とグラフ作成

質問

現在、以下のような作業をしていますが、
毎日のことなのでもう少しやりやすい方法はないかと思い質問させていただきます。よろしくお願いします。

【元データ】４枚のシート　　　　　
　（シート3）　

　　　　　　　 B1　 　11/11
------------------------------------------------------
A11　商品Ａ　　B11　　 0.91　　　　　　　　　　　
A13　商品Ｂ　 B13 　 21.00/23.00　　　
A27　商品Ｃ　 B27 　 11.00/13.00
A35　商品Ｄ　 B35 　240.0/245.0

【作成データ】
　　　　　　　U1　商品Ａ　　V1　商品Ｂ　　W1　商品Ｃ　　X1　商品Ｄ
----------------------------------------------------------------
T2　　11/1
・
・
・
T12　11/11　　　0.91　　　　　22　　　　　　12　　　　　　242.5
・
・
・
T31　11/30

【元データ】とは毎日配信されてくる商品の相場です。
このデータから商品４つの相場をコピーして、
【作成データ】にコピー。
作成データの数値から折れ線グラフを作成しています。

欲しいデータが4つのシートに分かれているので、
この作業を４回行っています。

以上のようなことを、マクロの記録で自動で出来ないかと思い、
やってみたのですが出来ませんでした。

やりたいことは以下のようなことです。

【元データ】のB1の日付を見て【作成データ】のT2からT31までの日付に、
【元データ】のA11とB11を見て【作成データ】のU2からX31に相場を入れたいです。
（相場が21.00/23.00のような場合は真ん中をとるようにしています）

【作成データ】の相場を折れ線グラフにしたいです。

一つ一つの作業は出来るのですが、
エクセルがもっと出来れば、もっともっと簡単に済んでしまうことなのかなと思い相談させていただきました。
マクロは記録しかやったことがないので、今回を機に教えて頂ければと思います。

よろしくお願いいたします。

回答No.16

xls88 · ベストアンサー

＞回答番号：No.15 この回答への補足
それでは、途中ではありますが、これで最後にしたいと思います。
大変失礼しました。

Sub goo_Macro4()
　　Dim r As Long '貼り付け先の行番号を入れる変数 (5)-a

　　'変数rに見つかったセルの行番号を代入 (5)-b
　　Sheets("Sheet5").Select
　　'Range("U2:X33").ClearContents
　　With Range(Range("T2"), Range("T2").End(xlDown))
　　　　r = .Find(What:=Sheets("Sheet1").Range("B1").Value, _
　　　　　　after:=Range("T2"), LookIn:=xlFormulas, _
　　　　　　LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
　　　　　　MatchCase:=False, MatchByte:=False).row
　　End With

　　'行番号rでSheet5に貼り付け (6)
　　With Sheets("Sheet5") '(4)-a
　　　　Sheets("Sheet1").Range("B11").Copy .Range("U" & r)
　　　　Sheets("Sheet1").Range("B13").Copy .Range("V" & r)
　　　　Sheets("Sheet1").Range("B27").Copy .Range("W" & r)
　　　　Sheets("Sheet1").Range("B35").Copy .Range("X" & r)
　　End With　　'(4)-b
End Sub

お礼

なにもわからない私に何度も丁寧に教えてくださりありがとうございました。

回答No.15

xls88

＞回答番号：No.14 この回答への補足
Sheet5のT400セルにはどんなデータが入っているのでしょうか。
Sheet5のT列日付データの最下行の行番号は何番になっていますか？
T400セルまで空白セルがなくデータが途切れなく続いているのですか？
続いているようなら、下記のように日付セル範囲を指定すればどうなるでしょうか。

　　With Range(Range("T2"), Range("T2:T32")
　　　　r = .Find(What:=Sheets("Sheet1").Range("B1").Value, _
　　　　　　after:=Range("T2"), LookIn:=xlFormulas, _
　　　　　　LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
　　　　　　MatchCase:=False, MatchByte:=False).Row
　　End With

＞回答番号：No.14 この回答へのお礼
エラーとなるコードを見ないことには何ともコメントできません。
考えるための材料を提供するようにしてください。

補足

T400には何も入っていません。
Tの行は1日～31日までなので、T32までになります。

ここまで教えて頂いて申し訳ないのですが、
私には難しすぎたようです。
考えてみてくださいと言われても、
ヘルプを見ても、なにがなんだかわからないのです。

11日のデータが移せたときは感動しましたが、
その応用となると、どこをどう考えて比較して、何を加えたらいいのかわからず・・・

ここであきらめて、今までどおりやっていくしかないのかなと思っています。

回答No.14

xls88

＞回答番号：No.13 この回答への補足
違っている箇所が、どのように書き換えられているかを良く見てください。
慣れてくると意味が解るようになります。
意味が解らないまでも、英語の意味からある程度、推測できないでしょうか。

VBEのヘルプで、例えばFindという単語を調べる方法です。
VBEの画面で、Find（文字列上）にキャレット（文字カーソル）を置いてF1キーを押してみてください。
ヘルプがFindメソッドのページにジャンプして表示されます。

マクロgoo_Macro3のコードですが、

r = .Find(What:=Sheets("Sheet1").Range("B1").FormulaR1C1, _
　　after:=Range("T2"), LookIn:=xlFormulas, _
　　LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
　　MatchCase:=False, MatchByte:=False).Row

上記で、引数Whatのところを
What:=Sheets("Sheet1").Range("B1").FormulaR1C1
から
What:=Sheets("Sheet1").Range("B1").Value
に書き換えて、再度マクロを実行してみてください。

メッセージボックスに行番号が表示されないでしょうか？

お礼

すみません、コードをいじっていたら、
「オブジェクト変数またはwithブロック変数が設定されていません」と
出てきてしまいました。

マクロの記録しかやったことがなく、教えて頂いてやってはみましたが、
コードの意味を理解するのが難しく、英語の意味での憶測も同じで・・・
正直なにがなんだかわからない状態です。

補足

ヘルプの画面でいろいろ見てみました。
ありがとうございました。

メッセージボックスには今度は「400」と出てきてしまいます・・・

回答No.13

xls88

マクロ goo_Macro3 は、変数rに「検索されたセルの行番号」を取得するように、既に編集してあります。
マクロ goo_Macro3 の前半部と、日付の「検索」を「マクロの記録」して得られたコードを見比べてください。
確認できたら、マクロ goo_Macro3 を実行してみてください。
検索で見つかったセルの「行番号」がメッセージボックスで表示されます。
「行番号」が合っているかどうかみてください。

次に、ここで得られた「行番号」を、商品データの貼り付け先セル番地の「行番号」に当て嵌めます。
商品データの、貼り付け先セル番地の「列番号」は固定ということですから、
「日付データ」に応じた行に、商品データが貼り付けられることになります。
考えてみてください。

補足

前半部分と日付検索のコードを見比べてみましたが、
これはコードが読めなくてもわかるものなのでしょうか？
一部同じということしかわかりませんでした。
また、実行してみましたがメッセージボックスには「0」と出てしまいます。

回答No.12

xls88

＞回答番号：No.11 この回答への補足
それでいいので、回答番号：No.7に戻って
「検索されたセルの行番号を取得」して「貼り付け先セルの行指定」に利用する
作業を進めてください。

これが出来ると、Sheet1のB1セルと同じ日付のSheet5の欄（行）に、各商品の数値データをコピペすることができるようになります。

補足

本当に申し訳ないのですが、
Sub goo_Macro3()
　　Dim r As Long　'(5)-a 検索結果の行番号を入れる変数

　　''(5)-b 変数rに見つかったセル番地の行番号を取得する
　　Sheets("Sheet5").Select
　　With Range(Range("T2"), Range("T2").End(xlDown))
　　　　r = .Find(What:=Sheets("Sheet1").Range("B1").FormulaR1C1, _
　　　　　　after:=Range("T2"), LookIn:=xlFormulas, _
　　　　　　LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
　　　　　　MatchCase:=False, MatchByte:=False).Row
　　End With
　　Msgbox r　'(5)-c rの値を確認

　　With Sheets("Sheet1")　'(4)-a
　　　　.Range("B11").Copy Sheets("Sheet5").Range("U12")
　　　　.Range("B13").Copy Sheets("Sheet5").Range("V12")
　　　　.Range("B27").Copy Sheets("Sheet5").Range("W12")
　　　　.Range("B35").Copy Sheets("Sheet5").Range("X12")
　　End With　　'(4)-b
End Sub

このコードの…
(5)-a、(5)-bを追加変更すれば…というところの、
どこが(5)-a、どこが(5)-bを指しているのかもわからなく、
変数rなど知らない言葉が出てきて、
色々調べたのですが、理解できませんでした。

Sheets("Sheet1").Select
Range("B1").Select
ActiveCell.FormulaR1C1 = "11/11/2008"
Sheets("Sheet5").Select
　　Range("T2").Select
　　Range(Selection, Selection.End(xlDown)).Select
　　Selection.Find(What:="11/11/2008", after:=ActiveCell, LookIn:=xlFormulas, _
　　　　LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
　　　　MatchCase:=False, MatchByte:=False, SearchFormat:=False).Activate
End Sub

↑ここまでで日付検索してるんですよね…？

申し訳ないのですが、どこが(5)-a、どこが(5)-bなのか、
なにを追加変更するのか教えていただけないでしょうか？

よろしくお願い申し上げます。

回答No.11

xls88

＞回答番号：No.10 この回答への補足
それでいいので、回答番号：No.7に戻って進めてください。

補足

このコードを入れるということなのでしょうか？

　　Sheets("Sheet5").Select
　　With Range(Range("T2"), Range("T2").End(xlDown))
　　　　.Find(What:=Sheets("Sheet1").Range("B1").FormulaR1C1, _
　　　　　　after:=Range("T2"), LookIn:=xlFormulas, _
　　　　　　LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
　　　　　　MatchCase:=False, MatchByte:=False).Activate

回答No.10

xls88

＞回答番号：No.9 この回答への補足

>Sheets("Sheet1").Select
>Range("B1").Select
>ActiveCell.FormulaR1C1 = "11/11/2008"
>Sheets("Sheet5").Select
>Range("T2").Select
>Range(Selection, Selection.End(xlDown)).Select
は
Sheet5を選択
T2セルを選択
Shift＋Ctrl＋↓ とキー操作して、日付データ範囲を選択
ここまでの記録です。続けて

Ctrl＋F で「検索」ダイアログボックスを表示
Ctrl＋V で「検索する文字列」に、コピーした日付データを貼り付ける
Enter、またはAlt＋F で「次を検索」する
Alt＋I で「すべて検索」する（検索されたT12セルが選択される）

といった操作を「マクロの記録」してください。

お礼

Sheets("Sheet5").Select
　　Range("T2").Select
　　Range(Selection, Selection.End(xlDown)).Select
　　Selection.Find(What:="11/11/2008", after:=ActiveCell, LookIn:=xlFormulas, _
　　　　LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
　　　　MatchCase:=False, MatchByte:=False, SearchFormat:=False).Activate

このコードが入るはずとおっしゃられていますか？

補足

今、もう一度やり直したんですが、
検索までやったマクロが上のコードになってしまいます。
Ctrl＋F で「検索」ダイアログボックスを表示
Ctrl＋V で「検索する文字列」に、コピーした日付データを貼り付ける
Enter、またはAlt＋F で「次を検索」する
Alt＋I で「すべて検索」する（検索されたT12セルが選択される）
この作業をやって、Sheet5のT12にセルがいったところまでやっています。

どこで間違っているのでしょうか？

回答No.9

xls88

＞回答番号：No.8 この回答への補足

>Sheets("Sheet1").Select
>Range("B1").Select
>ActiveCell.FormulaR1C1 = "11/11/2008"
は
Sheet1を選択
B1セルを選択
数式バーに表示された内容を選択し、Ctrl＋C でコピー
ここまでの操作記録です。
次に、以下の操作をこの通りに間違えなく「マクロの記録」してください。
日付データを「検索」するコードが記録されると思います。

Sheet5を選択
T2セルを選択
Shift＋Ctrl＋↓ とキー操作して、日付データ範囲を選択
Ctrl＋F で「検索」ダイアログボックスを表示
Ctrl＋V で「検索する文字列」に、コピーした日付データを貼り付ける
Enter、またはAlt＋F で「次を検索」する
Alt＋I で「すべて検索」する（検索されたT12セルが選択される）

補足

Sub Macro5()
'
' Macro5 Macro
'

'
Sheets("Sheet1").Select
Range("B1").Select
ActiveCell.FormulaR1C1 = "11/11/2008"
Sheets("Sheet5").Select
Range("T2").Select
Range(Selection, Selection.End(xlDown)).Select
End Sub

何度も申し訳ありません
ここまでのことでしょうか？

回答No.8

xls88

＞回答番号：No.7 この回答への補足
日付データの「検索」が「マクロの記録」されていません。
もう一度、下記の操作手順を「マクロの記録」してみてください。
やろうとしていることが解ると思います。

Sheet1を選択
B1セルを選択
数式バーに表示された内容を選択し、Ctrl＋C でコピー
Sheet5を選択
T2セルを選択
Shift＋Ctrl＋↓とキー操作して、日付データ範囲を選択
Ctrl＋F で「検索」ダイアログボックスを表示
検索する文字列のボックスに、Ctrl＋V で日付データを貼り付け
EnterまたはAlt＋F で「次を検索」
Alt＋I で「すべて検索」（検索されたT12セルが選択される）

補足

Sheets("Sheet1").Select
Range("B1").Select
ActiveCell.FormulaR1C1 = "11/11/2008"

ここの部分のことでしょうか？

回答No.7

xls88

＞回答番号：No.6 この回答への補足
>昨晩からやっているのですが、何度やってもまとめたコード部分でエラーが出てしまいます。
エラーの出るコードを掲載していただいた方が間違いを指摘できます。

＞回答番号：No.6 この回答へのお礼
まとめられたコピペ部分は、Sheets("Sheet1")をWith文にして、下記の(4)-a、(4)-bのようにできます。

Sub goo_Macro2()

　　With Sheets("Sheet1")　'(4)-a
　　　　.Range("B11").Copy Sheets("Sheet5").Range("U12")
　　　　.Range("B13").Copy Sheets("Sheet5").Range("V12")
　　　　.Range("B27").Copy Sheets("Sheet5").Range("W12")
　　　　.Range("B35").Copy Sheets("Sheet5").Range("X12")
　　End With　　'(4)-b
End Sub

次は、Sheet1のB1セルの日付を、Sheet5で検索した結果を利用できるようにします。
回答番号：No.3のコードで示した、Sheet1のB1セルの日付をSheet5で検索する部分を追加します。

Sub goo_Macro3()
　　Dim r As Long　'(5)-a 検索結果の行番号を入れる変数

　　''(5)-b 変数rに見つかったセル番地の行番号を取得する
　　Sheets("Sheet5").Select
　　With Range(Range("T2"), Range("T2").End(xlDown))
　　　　r = .Find(What:=Sheets("Sheet1").Range("B1").FormulaR1C1, _
　　　　　　after:=Range("T2"), LookIn:=xlFormulas, _
　　　　　　LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
　　　　　　MatchCase:=False, MatchByte:=False).Row
　　End With
　　Msgbox r　'(5)-c rの値を確認

　　With Sheets("Sheet1")　'(4)-a
　　　　.Range("B11").Copy Sheets("Sheet5").Range("U12")
　　　　.Range("B13").Copy Sheets("Sheet5").Range("V12")
　　　　.Range("B27").Copy Sheets("Sheet5").Range("W12")
　　　　.Range("B35").Copy Sheets("Sheet5").Range("X12")
　　End With　　'(4)-b
End Sub

(5)-a、(5)-bを追加変更すれば、変数rに、貼り付け先の行番号が取得されます。
現状のコードでは(4)-a～(4)-bで、貼り付け先のセル番地が固定されています。
セル番地の行番号に、rを当てはめれば検索する日付に応じて貼り付け先の制御が可能になります。
つまり、Sheet1のB1セルの日付に応じて、Sheet5のU列からX列の r行に貼りつけられるようになります。

どうすれば良いか考えてみてください。

補足

今、固定になっている検索と検索結果のコピペを、
Sheet1のB1を検索して、Sheet5のT2から下を検索、該当のUからXに貼り付けるということはわかるのですが、
どうすればいいのかまったくわかりません。。。

(5)-a、(5)-bを追加変更すれば・・・

というのは、
　Dim r As Long　に　'(5)-a 検索結果の行番号を入れる変数

Sheet1のB1の結果をSheet5のT2からT32から探すということなんでしょうか？

(5)-bというのはどの部分になりますか？

回答No.6

xls88

CopyしてPaste部分が1行にまとまったら、回答番号：No.3の日付検索部分のコードも追加します。
できたなら、編集したコードを掲載してください。

再度確認します。Sheet1の
A11　商品Ａ　　　　　　　　　　
A13　商品Ｂ
A27　商品Ｃ
A35　商品Ｄ
は、商品名が固定入力されている。
B11　　0.91　　　　　　　　　　　
B13 　 21.00/23.00　　　
B27 　 11.00/13.00
B35 　 240.0/245.0
は、データが配信されると上書き入力される。
B1　 　11/11
は、データが配信された日付が上書き入力される。
ということで良いのでしょうか？
回答番号：No.3の補足で、レイアウトは固定だということなので、上記のように解釈しています。

今、進めているのは、
Sheet1のB1の日付データを、Sheet5のT列で検索し、
日付が検索された行で、各商品の列に、Sheet1の商品データをCopy & Pasteしようとしています。

お礼

すみませんでした。
ここまでできました。
Sub goo_Macro1()

Sheets("Sheet1").Range("B11").Copy Sheets("Sheet5").Range("U12")

Sheets("Sheet1").Range("B13").Copy Sheets("Sheet5").Range("V12")

Sheets("Sheet1").Range("B27").Copy Sheets("Sheet5").Range("W12")

Sheets("Sheet1").Range("B35").Copy Sheets("Sheet5").Range("X12")
End Sub

補足

レイアウトの件ですが、これは固定になります。

昨晩からやっているのですが、何度やってもまとめたコード部分でエラーが出てしまいます。
今、やることは、

　'Sheets("Sheet1").Select
　　'Range("B11").Select
　　'Selection.Copy
　　'Sheets("Sheet5").Select
　　'Range("U12").Select
　　'ActiveSheet.Paste
↑の6行を、↓のように1行にまとめています。
　　Sheets("Sheet1").Range("B11").Copy Sheets("Sheet5").Range("U12")　'(3)---コメント

とのことでしたので、他のB13、B27、B35も同じようにしてみたのですが、
1行にまとめるということは、上の6行は消してもいいということですよね？

ごちゃごちゃになってしまい困惑しているのですが、
一番最初に教えて頂いた通りやって私が貼り付けたコードが、
回答No.３のようにまとめられるという解釈でよろしいでしょうか？