
ノートPC数台導入につき、
現在、Kakaku.comにて候補を挙げ、
Excel2003にて比較表を作成しているのですが、
ファイルを開いた時点で価格情報を現時点での最安価格に更新
する方法はないでしょうか。
現在は、都度、サイトにアクセスし、
機種ごとに価格をコピー&ペーストして更新していますが、
10機種ほどピックアップしているため手間がかかること、
今後もこのような対応が定期的に必要となるため、
なるべく自動更新に近い方法があればご教示よろしくお願い致します。
比較表はスクリーンショット添付しましたので、ご参照いただければと思います。
また比較表はkakaku.comの製品詳細比較機能で作成できるテーブルを
編集して作成しています。
更新したい情報は赤枠で囲んだ各モデルの最安価格となります。
ショップ名等の情報は不要です。
以上,よろしくお願い致します。

No.3ベストアンサー
- 回答日時:
こんばんは。
標準モジュールに貼りつけます。
以下のユーザー設定の部分を書き換えてください。
フォームのコマンドボタンなので、このマクロを登録してくれれば、それをクリックするだけで価格を取得できます。こちらでは、成功しています。
設定の仕方:
ここに、該当する個々の機種のURLをセルに書き込み、P列なら、P列に書き込みます。縦でも横でもよいです。
Set rngData = .Range("P1:P10")
出力する場所で、画像をみると、以下のように見えました。
Set outData = .Range("B26:K26")
URLの数と、書き込むセルの数さえ合わせていただければ良いです。
''標準モジュール
'-------------------------------------------
Sub Main()
Dim sPrice As String
Dim i As Long
Dim rngData As Range
Dim outData As Range
'出力が遅いと感じたら、以下を外します。
'Application.ScreenUpdating = False
With ActiveSheet
'-------------------------------------------
''ユーザー設定
'必要なURLをP1~P10 に書き込む
Set rngData = .Range("P1:P10")
'書き出す場所
Set outData = .Range("B26:K26")
'-------------------------------------------
For i = 1 To rngData.Cells.Count
If rngData.Cells(i).Value <> "" Then
sPrice = GetPrices(rngData.Cells(i).Value)
If sPrice <> "" Then
outData.Cells(i).Value = sPrice
End If
End If
Next i
End With
'Application.ScreenUpdating = True
End Sub
Function GetPrices(ByVal strURL As String)
'価格.COMから、最安値を取得する関数
Dim objHTTP As Object
Dim httpLog As String
Dim i As Long
Dim buf As String
Dim Matches As Object
'10/02/08 現在の価格.COMのHTMLコード
'サイトの内容が変わって取れなくなったら、sKEYの部分を書き換えてください。
Const sKEY As String = "lid=shop_itemview_"
Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
On Error Resume Next
objHTTP.Open "GET", strURL, False
objHTTP.Send
On Error GoTo 0
On Error GoTo ErrHandler
If objHTTP.Status = 200 Then
httpLog = objHTTP.ResponseText
End If
i = InStr(1, httpLog, sKEY, 1)
If i > 0 Then
buf = Mid$(httpLog, i + Len(sKEY), 30)
With CreateObject("VBScript.RegExp")
.Pattern = "yen;([\d,]+)"
.Global = False
Set Matches = .Execute(buf)
buf = Matches(0).SubMatches(0)
GetPrices = buf
End With
End If
ErrHandler:
If Err.Number > 0 Then
GetPrices = ""
End If
Set objHTTP = Nothing
End Function
大変連絡が遅くなり申し訳ありません。
本日、早速試してみました。
見事です!感動しました!
これで手間が大幅に軽減されます。
本当にありがとうございました。
No.2
- 回答日時:
こんにちは。
私なら、マクロがよいのではないかと思いますが、そういう方向でよろしいのでしょうか?
シートにURLを書いてもらって、それを順に呼び出すスタイルにします。
しかし、ご質問者さんの過去の質問の対応を見ていると、何のコメントも付けずに締めてしまったりしていますので、一応、コードを掲載したりするのは、きちんとした確認をしてからにさせていただきます。マクロのコードが不要でしたら、無視しても構いません。#1様の方法でも、Webサイトから一括してして取れれば問題はないと思います。そうでない場合は、その数だけWebクリエを作らなくてはならないかもしれません。私は専門家ではありませんので、間違いかもしれませんが。
Wendy02さん
回答ありがとうございます。
よろしければ、マクロいただけないでしょうか。
作成していただくにあたって、さらになにか情報が必要であれば
お知らせください。
よろしくお願い致します。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
標準価格と定価と希望小売価格...
-
こんなエラーがこのサイトで出ます
-
「一般カテ」という名目が入ると
-
あなたはこのサイト 3日ほど ...
-
enebaというサイトなんですが
-
股ぐり
-
ThinkPad E15 Gen 2 ってもう前...
-
影、悪、闇、死、血、死神、悪...
-
「くろうみやまのほととぎす」...
-
現時点ではこのアカウントで Yo...
-
「あなたがアクセスしようとし...
-
この画像の右の中国人?巨乳美...
-
タランチュラは益虫ですか?
-
gooってグーグルと関係あります...
-
太宰府天滿宮 求解籤詩
-
読み方
-
痴女ってどうゆう意味ですか? ...
-
このセクシー女優誰かわかる人...
-
教えてgooで獲得したランクのポ...
-
スマホのアプリ
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
【質問の質低下】回答してあげ...
-
こんなエラーがこのサイトで出ます
-
「一般カテ」という名目が入ると
-
標準価格と定価と希望小売価格...
-
違法サイト
-
enebaというサイトなんですが
-
股ぐり
-
トリップサイト(異世界に行く?...
-
海外サイト Carethy について。
-
分からないのに回答したがる回答者
-
仕切価格ってどういいますか?
-
よいお年を!、、早いか?
-
教えてGOOでの質問がOKWAV...
-
マインドマップをWEB上で書...
-
あなたはこのサイト 3日ほど ...
-
Softbank Airはファーウェイ製...
-
EXCEL kakaku.com 最安価格の更...
-
セブンプレミアム商品の価格差...
-
海外サイトのrepostというボタ...
-
情報暴露マンのようなサイトを...
おすすめ情報