⇒⇒⇒⇒⇒⇒⇒⇒⇒⇒⇒⇒⇒⇒⇒⇒⇒ 最近本を出し、Webから株価データ取得 方法については　Excel2003、Excel2007 を例にそちらで詳しく説明しました。 また、前は解析ツール関連ＶＢＡの解説 コーナーには「ローソク足」「カイリ率」 「ボリンジャーバンド」「一目均衡表」 「RSI」等のマクロ説明を掲載していまし たが、出版した本に詳しく掲載した関係 でツール作成方法の解説は削除しました。 ⇒⇒⇒⇒⇒⇒⇒⇒⇒⇒⇒⇒⇒⇒⇒⇒⇒

.

⇒⇒⇒⇒⇒ 最強パワー アップ編は まだ　　　 あります。　 ご注文は　　 お早めに！　 ⇒⇒⇒⇒⇒

'==================================================================================
' Macro1 Macro
' マクロ記録日 : 2004/12/18  ユーザー名 : IRYO
'
    Range("A1").Select
    With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://money.www.infoseek.co.jp/MnStock/mn_slast.html?qt=7203.t&sy=2004&sm=8&sd=18&ey=2004&em=12&ed=18&k=d" _
        , Destination:=Range("A1"))
        .Name = _
        "mn_slast.html?qt=7203.t&sy=2004&sm=8&sd=18&ey=2004&em=12&ed=18&k=d"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "22"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
End Sub
'==================================================================================

'==================================================================================
Const URLYAHOO As String = "URL;http://money.www.infoseek.co.jp/"
Const BASHO As String = ".t"     '東証

Dim urlweb As String             'Web接続先
Dim meino As String   '銘柄コード
Dim ymden As Date     '取得end日
Dim ymdst As Date     '取得スタート日
Dim endr As Integer   '最終行
Dim d10y As String, d10m As String, d10d As String
Dim d11y As String, d11m As String, d11d As String
Sub load2_np()

'過去データ削除
 Cells.Select
    Selection.ClearContents
    Range("A1").Select

'銘柄コード指定
    msg = "Yahooファイナンスからデータ取得する銘柄コード入力"
    meino = InputBox(msg, "銘柄コード入力", "")
    If meino = "" Then
        MsgBox "取得する銘柄コードを入力して下さい"
        Exit Sub
    End If
    If Len(meino) <> 4 Then
        MsgBox "取得する銘柄コードを数字4桁で入力して下さい"
        Exit Sub
    End If
'==================================================================================

'==================================================================================
'取得日の指定
    yyy = Date
   msg = "データ取得する日付を指定して下さい"
    ymd = InputBox(msg, "銘柄コード入力", yyy)
    If ymd = "" Then
        MsgBox "取得する日付を入力して下さい"
        Exit Sub
    End If
    If IsDate(ymd) = False Then
        MsgBox "日付(yy/mm/dd)を入力して下さい"
        Exit Sub
    End If
    
'取得1
    ymden = ymd
    ymdst = ymden - 70
    endr = 3
    Call 取得準備
    
'取得2
    ymden = ymdst - 1
    ymdst = ymden - 70
    
    Cells(10000, 1).End(xlUp).Select
    endr = ActiveCell.Row + 1
    Call 取得準備

'==================================================================================

'==================================================================================
'データ整理
    Columns("B").Select             'B列をコピー
        Selection.Copy
    Range("G1").Select              'G列へ貼り付け
        ActiveSheet.Paste
    Columns("F:F").Select           'F列をコピー
    Selection.Copy
    Range("B1").Select              'B列へ貼り付け
    ActiveSheet.Paste
    Columns("F:F").Select            'F列のカット
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Range("H9").Select

    Cells(10000, 1).End(xlUp).Select
    cend2 = ActiveCell.Row
  
'株データ以外の行削除
For i = cend2 To 4 Step -1
  If IsNumeric(Cells(i, 2)) = False Or Cells(i, 2) = "" Then
       Rows(i).Select
       Selection.Delete Shift:=xlUp
  End If
Next
  Range("A1").Select
End Sub
'==================================================================================

'==================================================================================
ub 取得準備()
'スタート日
    d10y = Year(ymdst)
    d10m = Month(ymdst)
    d10d = Day(ymdst)
'収得日
    d11y = Year(ymden)
    d11m = Month(ymden)
    d11d = Day(ymden)
'URLと日付指定
urlweb = URLYAHOO & "MnStock/mn_slast.html?qt=" & meino & BASHO & "&sy=" & d10y & "&sm=" _
    & d10m & "&sd=" & d10d & "&ey=" & d11y & "&em=" & d11m & "&ed=" & d11d & "&k=d"
Call 取得

End Sub
'==================================================================================

'==================================================================================
Sub 取得()
With ActiveSheet.QueryTables.Add(Connection:=urlweb _
        , Destination:=Cells(endr, 1))
    .AdjustColumnWidth = True
    .WebSelectionType = xlSpecifiedTables
    .WebFormatting = xlWebFormattingNone
    .WebTables = "22"
    .Refresh BackgroundQuery:=False
End With
End Sub
'==================================================================================