エクセルのセルにネット上の特定の情報を自動的に反映させる方法を教えてください。

やりたいことは、「エクセル上の4桁の株価コードに対応する、最新の株価をネットから持ってきて、別のセルに表示する」ということです。具体的には、セルA1に「7203」という数字があった場合、日経の該当ページ(http://company.nikkei.co.jp/index.cfm?scode=7203)から、トヨタ自動車の株価を拾ってきて、A2に表示するようなものです。(株価が分かるのであれば、日経にはこだわりません。)

こちらのページ(http://www15.ocn.ne.jp/~range/menu/menu011_01.html)に紹介されているものをより限定した機能で使えればいいです。私はVBAに関してはド素人なので、そのつもりで説明をしていただければ助かります。よろしくお願いします。

回答の条件
  • 1人2回まで
  • 登録:
  • 終了:2007/09/12 06:12:44
※ 有料アンケート・ポイント付き質問機能は2023年2月28日に終了しました。

ベストアンサー

id:airplant No.2

回答回数220ベストアンサー獲得回数49

ポイント60pt

要は、既存のマクロは利用できないので、株価のみを取り出すマクロに修正したいということですね?


日経の話が先にあり、その後で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番目でした。→人によって違うかも知れません。

テーブルを上から順になめていって、「コード」というタイトルが出たら、それを株価が入っている場所としています。


元々のコーディングは、「タツ」さんに帰属します。

id:tsubo1

ちょっと時間が無くてまだ試せていないのですが、あとで使わせていただきます。手間がかかる質問内容だったのですが、丁寧にお答えをいただきありがとうございました。

2007/09/12 06:11:07

その他の回答1件)

id:airplant No.1

回答回数220ベストアンサー獲得回数49

ポイント40pt

何件取り込みたいか、どのように運用したいかによると思います。

1.簡単に行いたいとき

 Web上で見れて、必要に応じ保存したい場合は、例に挙がっている日経の「持ち株チェック」機能を使うのが一番いいのではないでしょうか?

 表示された後で、必要な箇所を囲んで、そのままExcelへペーストすれば、情報保存もできます。


2.Excelでやる(数件でいいとき)

 VBAが初めてのようですので、マクロで行わずに人手で同様のことを行えばいいと思います。

 Webからのテーブル取り込みで行います。

Step1.【データ】→【外部データの取り込み】→【新しいWebクエリ】

Step2.URLに指定銘柄の株価ページを指定する。

Step3.株価が入っているテーブルを選択する。

Step4.【取り込み】ボタンを押す

Step5.Excelを開いたときに自動更新するために、外部データのアイコンの【データ範囲プロパティ】で【ファイルを開くときにデータを更新する】にチェックをつける

Step6.必要銘柄分をStep1からStep5まで繰り返す。

なお、日経の場合、企業名が株価のテーブルに入っていないので、左側に人手で銘柄名を書いておく必要があります。


3.Excelでやる(マクロで行う)

 質問に書き込んであったページで説明されている(6)株価をチェックするの操作でそのまま動きます。

B列買いゾーン、C列注目ゾーンに何も入れなくても動作は問題ありませんでした。

>限定した機能で使えればいいです

 ここが良く分からないのですが、株価が取り込めればいいのだと思うので、このマクロを動かす上で何か問題ありますでしょうか?

id:tsubo1

回答をありがとうございます。ちょっと言葉がたりませんでした。余計な気遣いをさせてしまってすみませんでした。件数としては、一件だけではなく、たくさんの銘柄の株価を自動的にエクセルに反映させるものを意図していました。A列にずらずらっと4桁コードがならんでいるようなエクセルシートを用意しているので、それに対して最新の株価をしりたいと思っています。

3のマクロでやる、がいいようですね。

>>限定した機能で使えればいいです

>ここが良く分からないのですが

たしかにテンプレートをそのまま使ってもいいのですが、B/C列がそのままでよいのか不安だったのです。私の場合、B/C列以降にすでに他のデータが入っているので、テンプレートをいじる必要がおそらくあると思われます。(そんなら最初っから質問にそう書いとけってことですね。本当にごめんなさい)

2007/09/09 00:57:12
id:airplant No.2

回答回数220ベストアンサー獲得回数49ここでベストアンサー

ポイント60pt

要は、既存のマクロは利用できないので、株価のみを取り出すマクロに修正したいということですね?


日経の話が先にあり、その後で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番目でした。→人によって違うかも知れません。

テーブルを上から順になめていって、「コード」というタイトルが出たら、それを株価が入っている場所としています。


元々のコーディングは、「タツ」さんに帰属します。

id:tsubo1

ちょっと時間が無くてまだ試せていないのですが、あとで使わせていただきます。手間がかかる質問内容だったのですが、丁寧にお答えをいただきありがとうございました。

2007/09/12 06:11:07
  • id:airplant
    うまく動きましたでしょうか?
    いるかとたくさんのポイントありがとうございました。
    VBAマクロは、触っているとその内分かってきますから、一度触ってみることをお勧めします。
    Yahooの株価の項目位置が変わったら修正しないといけませんので。
  • id:tsubo1
    フォローアップをありがとうございます。ポイントはほんの気持ちということで。
    使ってみましたが、まったく問題なく作動しました。東証・ジャスダックに上場している銘柄のどちらも問題ありません。ご指摘のとおり、マクロでやらせると時間がかかるのには正直驚きましたが(いまのところ30銘柄くらい登録しているので)、この形でやらせたほうが、いろいろと応用がききますので、これで行こうと思います。ほんとに助かりました!

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

回答リクエストを送信したユーザーはいません