やりたいことは、「エクセル上の4桁の株価コードに対応する、最新の株価をネットから持ってきて、別のセルに表示する」ということです。具体的には、セルA1に「7203」という数字があった場合、日経の該当ページ(http://company.nikkei.co.jp/index.cfm?scode=7203)から、トヨタ自動車の株価を拾ってきて、A2に表示するようなものです。(株価が分かるのであれば、日経にはこだわりません。)
こちらのページ(http://www15.ocn.ne.jp/~range/menu/menu011_01.html)に紹介されているものをより限定した機能で使えればいいです。私はVBAに関してはド素人なので、そのつもりで説明をしていただければ助かります。よろしくお願いします。
要は、既存のマクロは利用できないので、株価のみを取り出すマクロに修正したいということですね?
日経の話が先にあり、その後でYahooのデータを基にしたちゃんと動くマクロが出ていたので、混乱してしまいました。
「多く」の単位が分かりませんが、もし100件以上とすると、マクロで動かすには少々時間がかかりますので、やはり日経で持株チェックに入れておいて、画面に出しておいてから、コピー&ペーストするのがお勧めですが。。。
件数が少ないという前提で、マクロを載せておきます。なお、1度目と2度目で仕様が違っていますので、どちらかというと2度目に合わせておきました。
最初の質問:A1=銘柄コード、A2=株価
二度目の回答:A列が銘柄コード、B,C列が何かのデータ?
マクロ仕様:A列が銘柄コード、2行目A2から始まる。株価は、E2、E3・・・へ入れる。
Option Explicit Sub 株価チェック() Const TargetRow As String = "E" '★株価を入れる列 Const YAHOO_1 As String = "URL;http://quote.yahoo.co.jp/q?s=" Const YAHOO_2 As String = "&d=v1&k=c3&h=on&z=m" Dim code As String Dim url As String Dim table_num As Integer Dim i As Integer Dim MySheet As Worksheet Dim NewSheet As Worksheet Application.ScreenUpdating = False Set MySheet = ActiveSheet MySheet.Copy before:=Sheets(1) Set NewSheet = ActiveSheet i = 0 Do code = Range("A2").Offset(i, 0).Value url = YAHOO_1 & code & YAHOO_2 table_num = 10 '★銘柄数が多いときは15にしておけば速くなる Do Columns("N:Z").Delete Shift:=xlToLeft With ActiveSheet.QueryTables.Add(Connection:= _ url, Destination:=Range("N1")) .RefreshStyle = xlInsertDeleteCells .AdjustColumnWidth = False .WebSelectionType = xlSpecifiedTables .WebFormatting = xlWebFormattingNone .WebTables = table_num .Refresh BackgroundQuery:=False End With table_num = table_num + 1 Loop Until Range("N1").Value = "コード" Or table_num = 20 Range("D2").Offset(i, 0).Value = Range("R2").Value With Range("N1:V3") .ClearContents .QueryTable.Delete End With i = i + 1 Loop Until Range("A2").Offset(i, 0).Value = "" Range("D2", "D" & (2 + i - 1)).Copy MySheet.Range(TargetRow & "2").PasteSpecial Paste:=xlPasteValues, _ Operation:=xlNone, SkipBlanks:=False, Transpose:=False Application.DisplayAlerts = False ActiveWindow.SelectedSheets.Delete Application.DisplayAlerts = True MySheet.Select Range("A1").Select Application.ScreenUpdating = True Set NewSheet = Nothing Set MySheet = Nothing End Sub
★の2箇所は変更してください。
最初の★:書かせる列
次の★:Yahoo上の株価があるHTML内でのテーブルの場所。今日現在では15番目でした。→人によって違うかも知れません。
テーブルを上から順になめていって、「コード」というタイトルが出たら、それを株価が入っている場所としています。
元々のコーディングは、「タツ」さんに帰属します。
何件取り込みたいか、どのように運用したいかによると思います。
1.簡単に行いたいとき
Web上で見れて、必要に応じ保存したい場合は、例に挙がっている日経の「持ち株チェック」機能を使うのが一番いいのではないでしょうか?
表示された後で、必要な箇所を囲んで、そのままExcelへペーストすれば、情報保存もできます。
2.Excelでやる(数件でいいとき)
VBAが初めてのようですので、マクロで行わずに人手で同様のことを行えばいいと思います。
Webからのテーブル取り込みで行います。
Step1.【データ】→【外部データの取り込み】→【新しいWebクエリ】
Step2.URLに指定銘柄の株価ページを指定する。
Step3.株価が入っているテーブルを選択する。
Step4.【取り込み】ボタンを押す
Step5.Excelを開いたときに自動更新するために、外部データのアイコンの【データ範囲プロパティ】で【ファイルを開くときにデータを更新する】にチェックをつける
Step6.必要銘柄分をStep1からStep5まで繰り返す。
なお、日経の場合、企業名が株価のテーブルに入っていないので、左側に人手で銘柄名を書いておく必要があります。
3.Excelでやる(マクロで行う)
質問に書き込んであったページで説明されている(6)株価をチェックするの操作でそのまま動きます。
B列買いゾーン、C列注目ゾーンに何も入れなくても動作は問題ありませんでした。
>限定した機能で使えればいいです
ここが良く分からないのですが、株価が取り込めればいいのだと思うので、このマクロを動かす上で何か問題ありますでしょうか?
回答をありがとうございます。ちょっと言葉がたりませんでした。余計な気遣いをさせてしまってすみませんでした。件数としては、一件だけではなく、たくさんの銘柄の株価を自動的にエクセルに反映させるものを意図していました。A列にずらずらっと4桁コードがならんでいるようなエクセルシートを用意しているので、それに対して最新の株価をしりたいと思っています。
3のマクロでやる、がいいようですね。
>>限定した機能で使えればいいです
>ここが良く分からないのですが
たしかにテンプレートをそのまま使ってもいいのですが、B/C列がそのままでよいのか不安だったのです。私の場合、B/C列以降にすでに他のデータが入っているので、テンプレートをいじる必要がおそらくあると思われます。(そんなら最初っから質問にそう書いとけってことですね。本当にごめんなさい)
要は、既存のマクロは利用できないので、株価のみを取り出すマクロに修正したいということですね?
日経の話が先にあり、その後でYahooのデータを基にしたちゃんと動くマクロが出ていたので、混乱してしまいました。
「多く」の単位が分かりませんが、もし100件以上とすると、マクロで動かすには少々時間がかかりますので、やはり日経で持株チェックに入れておいて、画面に出しておいてから、コピー&ペーストするのがお勧めですが。。。
件数が少ないという前提で、マクロを載せておきます。なお、1度目と2度目で仕様が違っていますので、どちらかというと2度目に合わせておきました。
最初の質問:A1=銘柄コード、A2=株価
二度目の回答:A列が銘柄コード、B,C列が何かのデータ?
マクロ仕様:A列が銘柄コード、2行目A2から始まる。株価は、E2、E3・・・へ入れる。
Option Explicit Sub 株価チェック() Const TargetRow As String = "E" '★株価を入れる列 Const YAHOO_1 As String = "URL;http://quote.yahoo.co.jp/q?s=" Const YAHOO_2 As String = "&d=v1&k=c3&h=on&z=m" Dim code As String Dim url As String Dim table_num As Integer Dim i As Integer Dim MySheet As Worksheet Dim NewSheet As Worksheet Application.ScreenUpdating = False Set MySheet = ActiveSheet MySheet.Copy before:=Sheets(1) Set NewSheet = ActiveSheet i = 0 Do code = Range("A2").Offset(i, 0).Value url = YAHOO_1 & code & YAHOO_2 table_num = 10 '★銘柄数が多いときは15にしておけば速くなる Do Columns("N:Z").Delete Shift:=xlToLeft With ActiveSheet.QueryTables.Add(Connection:= _ url, Destination:=Range("N1")) .RefreshStyle = xlInsertDeleteCells .AdjustColumnWidth = False .WebSelectionType = xlSpecifiedTables .WebFormatting = xlWebFormattingNone .WebTables = table_num .Refresh BackgroundQuery:=False End With table_num = table_num + 1 Loop Until Range("N1").Value = "コード" Or table_num = 20 Range("D2").Offset(i, 0).Value = Range("R2").Value With Range("N1:V3") .ClearContents .QueryTable.Delete End With i = i + 1 Loop Until Range("A2").Offset(i, 0).Value = "" Range("D2", "D" & (2 + i - 1)).Copy MySheet.Range(TargetRow & "2").PasteSpecial Paste:=xlPasteValues, _ Operation:=xlNone, SkipBlanks:=False, Transpose:=False Application.DisplayAlerts = False ActiveWindow.SelectedSheets.Delete Application.DisplayAlerts = True MySheet.Select Range("A1").Select Application.ScreenUpdating = True Set NewSheet = Nothing Set MySheet = Nothing End Sub
★の2箇所は変更してください。
最初の★:書かせる列
次の★:Yahoo上の株価があるHTML内でのテーブルの場所。今日現在では15番目でした。→人によって違うかも知れません。
テーブルを上から順になめていって、「コード」というタイトルが出たら、それを株価が入っている場所としています。
元々のコーディングは、「タツ」さんに帰属します。
ちょっと時間が無くてまだ試せていないのですが、あとで使わせていただきます。手間がかかる質問内容だったのですが、丁寧にお答えをいただきありがとうございました。
ちょっと時間が無くてまだ試せていないのですが、あとで使わせていただきます。手間がかかる質問内容だったのですが、丁寧にお答えをいただきありがとうございました。