Excel詳しい人

ネット上の数字とExcelの数字を同期させる方法はありますか？

No.3 ベストアンサー 回答者： WindFaller 回答日時： 2016/08/19 08:57

株価を想像していたのですが、金相場ですか。

Excelでなければ、Googleでつけておく方法もあるそうですが。
#2様のご紹介の、Webクエリでもいいです。

以下は、田中貴金属様のサイトから情報を取り出す、DOMのマクロです。
画面は一日に一度しか変わらないようですから、DOM(HTMLの骨組み）で取れます。

恒久的なマクロではありませんが、DOMで情報を取りやすいので、また面白いかと思います。分かる人は、これを元に試してみるとよいと思います。

ここのサイトは、なぜか、外部から取得しやすいようになっています。なお、外為の場合は、WinHttpでは取れません。また、外為のサイトの中では、Webクエリで取れないものもあります。そういう場合は、以下のコードとは違うアクセスの仕方があります。

下記のSelect Case を工夫すれば、サイトのほとんどの情報は、入手できるようです。

空のシートで試してみてください。
なお、「 "アクセスに失敗しました。」というエラーが返った時は、必ず、サイトを覗いてみてください。これは、通信に障害があった場合です。

それと、これを毎日決まった時間に取得する方法は、タスクスケジューラを使いますが、もう一つ違う技術が必要です。

'//
Sub GetPriceofGold()
　　Dim objHTTP As Object
　　Dim httpLog As String
　　Dim ar As Variant
　　Dim n As Variant
　　Dim strURL As String
　　On Error GoTo ErrHandler
　　'Microsoft WinHTTP Service, version 5.1
　　Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
　　
　　strURL = "http://gold.tanaka.co.jp/commodity/souba/d-gold. …
　　
　　objHTTP.Open "GET", strURL, False
　　objHTTP.Send
　
　　If objHTTP.Status <> 200 Then
　　　 MsgBox "アクセスに失敗しました。" & objHTTP.Status, vbExclamation
　　　 Exit Sub
　　Else
　　　　httpLog = objHTTP.ResponseText
　　　　Call GetLog(httpLog)
　　End If
ErrHandler:
If Err() > 0 Then
　 MsgBox Err.Number & " " & Err.Description
End If
Set objHTTP = Nothing
End Sub
Sub GetLog(httpLog As String)
　Dim mn As Variant, mdt
　Dim oHtml As Object
　Dim arBuf(4), buf As Variant
　Dim n As Variant
　Dim i As Long, j As Long
　Dim LastRow As Long, c As Range
　''Microsoft HTML Object Library
　LastRow = Cells(Rows.Count, 2).End(xlUp).Row
　If LastRow = 1 Then
　　Range("A1").Resize(, 5).Value = Array("地金価格公表日本時間", "税別小売価格", "小売価格先日比", "税込買取価格", "買取価格前日比")
　　For Each c In Range("A1:E1")
　　　c.EntireColumn.AutoFit
　　Next c
　End If
　Set oHtml = CreateObject("HTMLfile")
　oHtml.body.innerHTML = httpLog
　With oHtml
　　Set mn = .getElementByID("main")
　　mdt = Split(mn.innerText, vbCrLf)
　　For Each n In mdt
　　If n <> "" Then
　　　 Select Case True
　　　 Case n Like "地金価格*"
　　　　arBuf(0) = n
　　　 Case n Like "（小売価格*"
　　　　arBuf(1) = n
　　　 Case n Like "(*円)"
　　　　If arBuf(2) = "" Then
　　　　　 arBuf(2) = n
　　　　Else
　　　　　 arBuf(4) = n
　　　　　 Exit For
　　　　End If
　　　 Case n Like "（買取価格*"
　　　　arBuf(3) = n
　　　 End Select
　　 End If
　　Next
　　buf = Replace(arBuf(0), "地金価格", "")
　　buf = Mid(buf, 1, InStr(buf, "公表") - 1)
　　arBuf(0) = buf: buf = ""
　　
　　arBuf(1) = Mid(arBuf(1), InStr(1, arBuf(1), "）", 1) + 1)
　　arBuf(3) = Mid(arBuf(3), InStr(1, arBuf(3), "）", 1) + 1)
　End With
　Cells(LastRow + 1, 1).Resize(, 5) = arBuf()
　'数値変換(不要なら、ここまででも良い）
　For i = 2 To 5
　 Cells(LastRow + 1, i).Value = Replace(Cells(LastRow + 1, i).Value, "円", "")
　 Cells(LastRow + 1, i).Value = Val(Replace(Cells(LastRow + 1, i).Value, "(", "", , , 1))
　Next
End Sub

この回答へのお礼

ありがとうございます。少しずつ進めてみます。

お礼日時：2016/08/19 19:30

No.2 回答者： 銀鱗 回答日時： 2016/08/18 20:38

|ω・`)っ「WEBクエリ」

https://support.office.com/ja-jp/article/Web-%E3 …

この回答へのお礼

ありがとうございます。

お礼日時：2016/08/19 19:29

No.1 回答者： banzaiA 回答日時： 2016/08/18 19:44

＞ネット上の数字とExcelの数字を同期させる方法はありますか？

これには、私はどう答えて良いかわからない、ということは、エクセルに詳しくないと言うことですね。
あらためて、自分の力のなさを知りました。ありがとう。

この回答へのお礼

ありがとうございます。金の価格をExcelと同期させられた楽だと思ったのですが。コピペしたら済む話ですが、それが面倒でして。

お礼日時：2016/08/18 20:20