【Excel VBA マクロ】 Yahoo!ファイナンス:Webクエリでの株価取得方法

堺東のエステ サロン はインナーサーフェス.

堺東の筋膜リリースによる リラクゼーション マッサージサロン

堺東 エステ

ExcelのWebクエリを利用して株価を取得するコードです。

 

 

 

Yahoo!ファイナンスより

 

 

 

任意の企業を検索して

 

 

 

時系列タブから出力期間を表示後

 

 

 

URLを手動でコピー&ペーストします。

 

 

 

複数ページを取得する際には、『1~20件/xxx件中』(xxx ÷ 20)を参考に

 

 

 

遷移させるページの数値を入力し

 

 

 

【データ取得】をクリックします。

 

 

 

実際の使用例イメージにつきましては

 

 

 

任天堂さんの2019年1月1日~2020年12月31日<デイリー>483件を参考にしていますので

 

 

 

 

下記ダウンロードいただければと思います。

 

 

 

※株価については、ご参考という形にて

 お取り扱いにつきましては

 各個人様の管理下、十分ご留意いただき

 必要に応じて、別途多角的にご確認くださいませ。

 数値の保証は致しておりません。

 

 

 

※プログラムを動作する際には

 念のため、別途起動されているアプリケーション終了し

 必要に応じて、バックアップを取得した後にお試しください。

 ご利用のシステム環境によっては、作動しない場合がございます。

 【動作環境:Windows10 & Office365】


ダウンロード
株価取得ツール.xlsm
xlsm ファイル 47.2 KB

Option Explicit

Sub WebQueryT()

Application.ScreenUpdating = False

Dim strURL As String

Dim i As Long

Dim MaxRow As Long

    With Worksheets("top")

        If .Range("B5") = "" Then

            .Range("B5") = 1

        End If

        .Rows("10:1048576").Clear   '既存データ消去

        

        MaxRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1

        strURL = "URL;" & .Range("B4")

            For i = 1 To .Range("B5")

                With .QueryTables.Add(strURL & "&p=" & i, .Range("A" & MaxRow))

                    .WebSelectionType = xlSpecifiedTables

                    If i = 1 Then

                        .WebTables = "1,2"  '表1&表2

                    Else

                        .WebTables = "2"  '2Loop以降・・・表2のみ抽出

                    End If

                    '--------------------------------------------------

                    'xlEntirePage                     ページ全体

                    'xlAllTables                      すべてのテーブル

                    'xlSpecifiedTables                指定されたテーブル

                    .RefreshOnFileOpen = False       'ファイルを開く度、データ更新する際には「True」

                    '.Refresh                       'プロパティで設定した内容を反映更新してデータを出力

                    .Refresh BackgroundQuery:=False  '読み込み完了を待つ

                End With

                MaxRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1

            Next

            

            Dim qt As QueryTable    'クエリテーブル削除

            For Each qt In .QueryTables

                qt.Delete

            Next

         

            .Range("D10").WrapText = False              '前日比該当セル:文字の折り返し制御無し

            .Rows("10:10").Interior.ColorIndex = 0      '背景色無し

            .Columns("A:A").ColumnWidth = 23            '列幅調整

            .Range("A12:G" & MaxRow - 1).WrapText = False '文字の折り返し制御無し

            .Range("A12:G" & MaxRow - 1).MergeCells = False '並べ替えの為、結合解除

            .Range("A12").AutoFilter 1, "日付"          'フィルター設定

            .Range("A12").CurrentRegion. _

             Offset(1, 0).Resize(.Rows.Count - 12).EntireRow.Delete     '同項目削除

            .ShowAllData

            .Range("A12").CurrentRegion.Sort _

                Key1:=Range("A12"), Order1:=xlAscending, _

                Orientation:=xlTopToBottom, Header:=xlYes   '昇順

            

            Application.Goto .Range("A1"), True

            ActiveWindow.FreezePanes = False

            .Range("A13").Select

            ActiveWindow.FreezePanes = True 'ウィンドウ枠固定

            MsgBox ("終了")

    End With

Application.ScreenUpdating = True

End Sub

Sub allClear()

Application.ScreenUpdating = False

    With Worksheets("top")

        .Rows("10:1048576").Clear

        Application.Goto .Range("A1"), True

    End With

    ActiveWindow.FreezePanes = False

Application.ScreenUpdating = True

End Sub

堺東のマッサージ サロン はインナーサーフェス.

堺東の女性専用プライベートエステティックサロン【公式】inner surface.