(12)「tp16-鍋蓋足チャート」今日の値動き/詳細情報の掲載仕様変更に伴う対処方法
Yahooファイナンスの「今日の値動き」が2012/8/15からテーブルから文章に仕様変更があり対応（2012/8/17）

以下マクロの「灰色ステータス」を削除し、「オレンジステータス」に変える。
▼▼▼▼▼▼▼▼　Module21　▼▼▼▼▼▼▼▼
Public Const URLY As String = "http://quote.yahoo.co.jp/q?s="
Public Const urly As String = "http://stocks.finance.yahoo.co.jp/stocks/detail/?code="

----------------------------------------------------------------------
Sub 本日追加()
Application.StatusBar = "本日データ収集中 "
' urlk = urly & kabuno1 & basho & "&d=v2&k=c3&h=on&z=m"
urlk = urly & kabuno1 & basho
Call 正規今日
取得チェック
' If ydat(1) <> "コード" Then
If ydat(1) = "" Then
MsgBox "今日の値動きの追加に失敗しました"
Exit Sub
End If

出来高0チェック
' If IsNumeric(ydat(17)) = False Then
If IsNumeric(da(5)) = False Then
' MsgBox "現在出来高0で追加できません"
Exit Sub
End If

----------------------------------------------------------------------
Sub 正規今日()
Dim chk As Integer
Dim oHttp As Object
Dim dthtml As String
Dim j As Integer
Dim rck As Integer '→追加

stchk = InStr(stchk, dthtml, "名称", 1)
chks2 = InStr(stchk, dthtml, " 　・・・・・・・・・・・・・　下記までを削除　・・・・・・・・・・・・
da(4) = ydat(14) '現在値
da(5) = ydat(17) '出来高

***********　上記を削除し、下記に変える　**********************

stchk1 = InStr(1, dthtml, "リアルタイム株価", 1)
rck = 0
If stchk1 > 21000 Or stchk1 = 0 Then 　　　　　　　　　　 '2013/2月変更　20000→ 21000
stchk1 = InStr(1, dthtml, "20分ディレイ株価", 1)
rck = 1
End If
If stchk1 = 0 Then
ReDim ydat(7)
Else
dthtml = Mid$(dthtml, stchk1 - 50, 10000)
With .Execute(dthtml)
ccc = .Count
ReDim ydat(ccc)

jb = 0
For j = 1 To ccc - 1
ydat(j) = .Item(j + jb).SubMatches(0)
Next j
End With
On Error GoTo 0
End If
End With
Set oHttp = Nothing

データを配列へ
ReDim da(6)
For ib = 10 To 150
If ydat(ib) = "始値" Then da(1) = ydat(ib - (4 - rck))
If ydat(ib) = "高値" Then da(2) = ydat(ib - (4 - rck))
If ydat(ib) = "安値" Then da(3) = ydat(ib - (4 - rck))
If ydat(ib) = "前日比" Then da(4) = ydat(ib - 2)
If ydat(ib) = "出来高" Then
If IsNumeric(ydat(ib - 4)) = False Then
da(5) = 0
Else
da(5) = ydat(ib - 4)
End If

End If
Next