ExcelでのWebクエリについて

質問

ExcelでのWebクエリについて

Excel 2002を使い自社の販売価格と比較するため
差額計算ができる一覧表を作りました。

データ取り込み→sheet1→必要な列だけ別Sheet2にリンク→価格比較表

OSは WinXP sp3 を使用しております。

しかし、更新のたびに新製品がHPページにUP(毎日変動)されると
レコードがずれしまい指定セルの価格比較(差額)が出来なくなり
いつも訂正に時間を取られてしまいます。

外部データの範囲のプロパティでの設定(3番目の上書き)でも駄目です。

行列関数かなと思っているのですが、取り込みデータの範囲が増えてしまうので
どのような関数がベストなのかがわかりません。

VBAでの知識がなく難しい設定は出来ません。

良い方法などありますでしょうか。

http://kakaku.com/camera/camera-lens/ma_14/?lid=shop_pricemenu_makername

回答No.8

Wendy02 · ベストアンサー

大変に遅くなってすみません。
トータル行数は、209行ですが、多少、掲示するために加工してあります。

すでに、しばらく前からできていたのですが、掲示する問題が出てきてしまい、コードは、しばらく置いてありました。他のサイトを利用する方法もありますが、今までは規約違反だったので、躊躇してしまいました。

作ってみて、もう有償の範囲であることは気がついたのですが、かと言って、お約束の範囲で、多少でも可能性を示さなくてはいけませんので、不完全なものですが、今回のようなものを公開します。

現在、ここのサイトは、今年(2010)の改変より、2000字以上は入らなくなってしまい、事実上、こうしたプログラムコードの掲載は事実上支障があります。コードは3つに別けることになってしまいました。標準モジュールに貼り付けてください。もうこの種の質問は、なるべくVBA専門掲示板でお聞きになったほうが楽かもしれません。

本当は、ブックごとに分けられれば良いのですが、そこまでは、手を入れるには、ここの掲示板では限界があることに気が付きました。

別のご質問でAccessに組み込むことも可能なのですが、もう無料掲示板の範囲では不可能です。今回のものを、そのまま、Access に組み込むことも可能ですが、現在のようにExcelに入れて目で確認して、そこからAccessに登録したほうが安全かと思います。もちろん、Accessには、Web SpreadSheet もありますから、Excelがなくても同様のことは可能です。シート上は、ほとんど複雑なことはしていません。価格COMが一定のデータをはじき出していれば、もう少し楽なのですが、どうもそうではないようです。

お礼

Excel VBAという処理を初めて知りました。
砂時計がくるくるで面白いですね。
ご提供頂きました構文というのでしょうか、
今後の勉強素材にさせていただきます。

また、違う質問などすること有りましたら
その折は宜しくお願いいたします。

ありがとうございました。

補足

このたびは、本当にお世話になりました。

最後に1つだけ教えていただきたいのですが、

A1～A10 にURLを10個並べて実行すとラストの行で処理が留まってしまうのですが?????

デバックでプロシージャの呼び出し、もしくは引数が違うと出るのですが・・・

　　''品名
　　n = InStr(1, SmallLog(3), "<strong>", 1)
　　If n > 0 Then
　　　buf = Mid(SmallLog(3), n + 8, 50)
　　　buf = Mid(buf, 1, InStr(1, buf, "<", 1) - 1)

回答No.7

Wendy02

'//start of 3
　.Cells(x, "C").Value = sItemName(i)
　.Cells(x, "D").Value = sMaker(i)
　.Cells(x, "E").Value = sForMaker(i)
　.Cells(x, "F").Value = sPrice(i)
　.Cells(x, "G").Value = sShop(i)
　End If
　Next
　Application.ScreenUpdating = True
　End With
End Sub
Function LetterFiltersDbl(ByVal strTxt As String, Name1 As String, Name2 As String)
'メーカー名を切り離す
Dim Matches As Object, Match As Object, buf1 As String, buf2 As String, i As Long
　If IsArray(rAr) = False Then
　　rAr = Split(rMAKERName, ",")
　　oAr = Split(oMAKERName, ",")
　End If
　With CreateObject("VBScript.RegExp")
　.Pattern = "\(([ァ-ヾ\uFF61-\uFF9F\-]+).+\)"
　.Global = True
　Set Matches = .Execute(strTxt)
　If Matches.Count > 0 Then
　buf1 = Left(strTxt, InStr(1, strTxt, Matches(0).Value, 1) - 1)
　buf2 = Replace(Matches(0).Submatches(0), Space(1), "", , , 1)
　buf2 = StrConv(buf2, vbWide)
　buf2 = Replace(buf2, "－", "ー", , , 1)
　For i = LBound(rAr) To UBound(rAr)
　 If InStr(1, buf2, rAr(i), 1) > 0 Then
　　buf2 = jAr(i)
　　Exit For
　　 End If
　Next
　　For i = LBound(jAr) To UBound(jAr)
　　If InStr(1, buf2, jAr(i), 1) > 0 Then
　　buf2 = eAr(i)
　　Exit For
　　End If
　　Next
　　End If
　End With
　 Name1 = buf1: Name2 = buf2
End Function
Function LetterFilters(ByVal strTxt As String)
'メーカー名を直す
Dim Matches As Object, Match As Object, buf As String, i As Long
　If IsArray(rAr) = False Then
　　rAr = Split(rMAKERName, ",")
　　oAr = Split(oMAKERName, ",")
　End If
　With CreateObject("VBScript.RegExp")
　　.Pattern = "\(([ァ-ヶ\uFF61-\uFF9F]+).+\)"
　　.Global = True
　　Set Matches = .Execute(strTxt)
　　If Matches.Count > 0 Then
　　buf = Replace(Matches(0).Value, Space(1), "", , , 1)
　　strTxt = Replace(strTxt, Matches(0).Value, buf, , , 1)
　　buf = StrConv(Matches(0).Submatches(0), vbWide)
　　strTxt = Replace(strTxt, Matches(0).Submatches(0), buf, , , 1)
　　For i = LBound(rAr) To UBound(rAr)
　　 If InStr(1, strTxt, rAr(i), 1) > 0 Then
　　 strTxt = Replace(strTxt, buf, oAr(i), , , 1)
　　 End If
　　Next
　　End If
　End With
　LetterFilters = strTxt
End Function

回答No.6

Wendy02

'//start of 2
　Dim sMaker(60) As String, sItemName(60) As String, sForMaker(60) As String, sPrice(60) As String, sShop(60), sMount(60)
　'サイト内の情報が変わったらログを取ってください。
　BigLog = Split(httpLog, "class=""tr-border"">", , vbTextCompare)
　k = 0
　For Each a In BigLog
　　SmallLog = Split(a, "<td", , vbTextCompare)
　　''メーカー名
　　n = InStr(1, SmallLog(3), "class=""item", 1)
　　If n > 0 Then
　　　buf = Mid(SmallLog(3), n + 3, 30)
　　　n = InStr(1, buf, ">", 1)
　　　sMaker(k) = Mid(buf, n + 1, InStr(1, buf, "<", 1) - n - 1)
　　End If
　　''品名
　　n = InStr(1, SmallLog(3), "<strong>", 1)
　　If n > 0 Then
　　　buf = Mid(SmallLog(3), n + 9, 50)
　　　buf = Mid(buf, 1, InStr(1, buf, "<", 1) - 1)
　　　If flgSW = True Or InStr(1, buf, "(", 1) = 0 Then
　　　　　sItemName(k) = LetterFilters(buf)
　　　　　flgSW = True
　　　　Else
　　　　　LetterFiltersDbl buf, ItemName, ForMaker
　　　　　sItemName(k) = ItemName
　　　　　sForMaker(k) = ForMaker
　　　End If
　　End If
　　''価格
　　n = InStr(1, SmallLog(4), "td-price"">&#", 1)
　　If n > 0 Then
　　　n = InStr(1, SmallLog(4), ";", 1)
　　　buf = Mid(SmallLog(4), n + 1, 50)
　　　sPrice(k) = Mid(buf, 1, InStr(1, buf, "<", 1) - 1)
　　End If
　　''店名
　　n = InStr(1, SmallLog(4), "<br><span>", 1)
　　If n > 0 Then
　　　buf = Mid(SmallLog(4), n + 10, 50)
　　　sShop(k) = Mid(buf, 1, InStr(1, buf, "<", 1) - 1)
　　　k = k + 1
　　End If
　　If UBound(SmallLog) > 13 Then
　　　n = InStr(1, SmallLog(14), "&nbsp;", 1)
　　　If n > 0 Then
　　　　sMount(k) = Mid(SmallLog(14), 2, n - 2)
　　　End If
　　End If
　Next
　With Sheet2
　　'J列に移動
　　If cntFlg = 1 Then
　　　x = .Range("F10000").End(xlUp).Row
　　　.Range("F" & CStr(iST) & ":F" & CStr(x)).Copy .Range("J4")
　　　.Range("F" & CStr(iST) & ":F" & CStr(x)).ClearContents
　　End If
　　Application.ScreenUpdating = False
　　For i = 0 To UBound(sItemName)
　　　'C列が書き込みのスタート
　　　x = Application.Match(sItemName(i), .Columns("C"), 0)
　　　If IsNumeric(x) Then
　　　　.Cells(x, "F").Value = sPrice(i)
　　　Else
　　　　x = .Cells(Rows.Count, "C").End(xlUp).Offset(1).Row
　　　　If x < iST Then x = iST
'//end of 2

回答No.5

Wendy02

解説は最後に書きます。3pに渡ります

''//標準モジュール　start of 1
Private Const iST As Long = 4 'データのスタート行
Private Const rMAKERName As String = "キヤノン,ソニ－" ' 間違いリスト,"," で区切る
Private Const oMAKERName As String = "キャノン,ソニー" ' 正しいリスト,"," で区切る
Private Const jMAKERName As String = "キャノン,シグマ,ニコン,ペンタックス,コニカミノルタ,フォーザーズ,ソニー"
Private Const eMAKERName As String = "Canon,Sigma,Nikon,Pentax,KonicaMinolta,Four Thirds,Sony"
Private rAr As Variant
Private oAr As Variant
Private jAr As Variant
Private eAr As Variant
Private flgSW As Boolean
Private cntFlg As Integer
Sub Main()
　　'価格.com にアクセスし、シートに貼り付ける総合マクロ
　　Dim sPrice As String
　　Dim i As Long
　　Dim rngData As Range
　　Dim outData As Range
　　cntFlg = 0
　　'カタカナ語の不安定を変更
　　rAr = Split(rMAKERName, ",")
　　oAr = Split(oMAKERName, ",")
　　'日本語から英語へ
　　jAr = Split(jMAKERName, ",")
　　eAr = Split(eMAKERName, ",")

　　With Worksheets("Sheet1")
　　''ユーザSー設定
　　Set rngData = .Range("A1", .Range("A10000").End(xlUp))
　　For i = 1 To rngData.Cells.Count
　　　　If rngData.Cells(i).Value <> "" Then
　　　　　　cntFlg = i
　　　　　　GetLogs rngData.Cells(i).Value
　　　　End If
　　Next i
　　End With
　　Beep
End Sub
Function GetLogs(ByVal strURL As String)
　'価格.com にアクセスする関数
'価格.COMから、価格情報を取り出す関数
Dim objHTTP As Object
Dim httpLog As String
Dim i As Long
Dim buf As String
'10/08/20 現在の価格.COMのHTMLコード
　　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
　　　　 Call SplitLogs(httpLog)
　　End If
ErrHandler:
If Err.Number > 0 Then
　MsgBox Err.Number & " : " & Err.Description
End If
Set objHTTP = Nothing
End Function
Private Sub SplitLogs(ByVal httpLog As String)
　'ログからメーカー名、金額、品名を取り出すマクロ
　Dim BigLog As Variant
　Dim SmallLog As Variant
　Dim a As Variant, n As Long
　Dim buf As String
　Dim i As Long, j As Long, k As Long, x As Variant
　Dim ItemName As String, ForMaker As String
'//end of 1

お礼

このたびは、大変お手数をおかけしております。

すばらしいことが出来ような予感です。

また、この長文を拝見させて頂き大変恐縮しております。

私には、全然理解不能ですがどうかご教授宜しくお願いいたします。

取り合えず先にお礼を言わせて頂きます。

ありがとうございました。

回答No.4

DOUGLAS_

簡単なトコロからお答えいたします。

--------------------------------------------

＞(3)
＞誤　キヤノン・キヤノン(半角)・キヤノン AF・スペース挿入
＞正　キャノン
とのことですが、正式には「キヤノン（読みがキャノン）」のようですね。
http://ja.wikipedia.org/wiki/Canon

--------------------------------------------

＞教えていただきましたSUBSTITUTEを使うと#VALUE!が出ます。
＞調べてみるとワイルドカードで?と*が使えないようで下記内容に変えてみました。
　この点につきましては、こちらの意図に反して「?」になってしまったのですが、ワイルドカード ではなくて、円記号「\」がそこに入っています。

　従って、
B2:B55 ： =SUBSTITUTE(OFFSET(Sheet1!D$1,ROW()*3-3,),"\","")*1
というような式にしたかったのですが、実際に Sheet1 Ｅ列に入っている円記号は、char(92) の「\」ではなくて、char(63) のようです。

　Sheet1!E4 の セル 内で コピー して、計算式の中に ペースト してみてください。

--------------------------------------------

＞(2)ご提示頂きました件で、プロパティーでの設定ではゼロ値の非表示は有りますが、
＞その他の処理がわかりません。
＞・全角・半角や大文字・小文字の相違を出さない。
＞・スペースの過不足がない。

　これは、「一覧表」に登録してある「製品名・型番」の文字列と、「データ取り込み」した「製品名・型番」とが全く同じ文字列になるようにしていないと、Sheet2 の E2 に入っている
=VLOOKUP(B2,Sheet3!B:C,2,FALSE)
という式が誤作動を起こしますよ！ という意味です。

　逆の言い方をすれば、「データ取り込み」した「製品名・型番」を「一覧表」に コピペ して登録した方が無難かな、という意味ですが、価格.com 自体で「製品名・型番」の表記に揺れがあるようなことがあるとすれば、この心配は全く無駄になりますね。

--------------------------------------------

　その他の点につきましいて。。。

　最終的に Access へ エクスポート することは エクセル の ＶＢＡ でもできたかと存じますが、現時点での問題点は、
Ａ）どうやって「必要メーカー」のみの データ を抽出（及び、並べ替え）するか。
Ｂ）抽出された データ と「一覧表」の「製品名・型番」の表記の合致性をどのように保つか。
という２点かと存じます。

　先ず、（Ｂ）に関しては、「製品名・型番」そのものではなくて、価格.com の「製品名・型番」に貼ってある リンク先アドレス、例えば、「10-20mm F3.5 EX DC HSM (キヤノン用)」の場合は、
http://kakaku.com/item/K0000041291/
となっていますので、「K0000041291」という文字列を「製品名・型番」の替わりに使うことで回避できそうです。

　（Ａ）も含めて [新しい Web クエリ] による データ取り込み では無理ですので、
CreateObject("InternetExplorer.Application")
によって、WebBrowser オブジェクト を参照すれば。。。と思っていたのですが、改めて #1 Wendy02 さんがお示しの ＵＲＬ に書いていらっしゃる WinHttp ライブラリ を拝見＆テスト してみて、その圧倒的な速さに驚嘆した次第です。

　ということで、大変失礼ながら、このお題からは降ろさせていただきます。
　お騒がせいたしました。　　<(_ _)>

お礼

ご連絡遅くなりました。

キヤノンが正解とは知りませんでした。
自社のデータを訂正いたしました。

?のコピーで出来ました。
こういうやり方でエラー回避が出来るのですね。。。

OFFSET関数の場合、sheet2上でA列の並べ替えが出来ない
10行ごとに空白行が残ります。

でもとても勉強になりました。

今回は、お時間を作って頂き、適切なご回答ありがとうございました。

また難題が有りましたらUPすることが多分ありますので

その折は宜しくお願いいたします。

回答No.3

Wendy02

マクロでは、取り込み対象列の部分を取得する、基本的な部分は出来ました。
今のだけでも、Webクエリとは格段の差はあるはずです。順序が変わっても、正しく値段を書き込みます。

同じ品名を探して、その行の価格の部分に書き込みするということも作りました。

>H列　New 新値を関数で数値に変換[ =MID(F2,2,7) ]

マクロでは、この部分は不要になりますね。文字データではありませんから。

更新前の価格　[ =H2-J2 ]の部分は、手動でお願いします。ここまで、マクロでやってしまうのは、なんとなく、がんじがらめという感じになってしまうような気がします。

J列　Old 更新前の価格(前日以前)　は、貼付けします。

>(2)http://kakaku.com/camera/camera-lens/ma_311/n100 …
>　　http://kakaku.com/camera/camera-lens/ma_311/n100 …
>商品数　57品目　すべて取り込み
これは、アドレスを二つ並べれば、ひとつにまとめます。

ブックの指定とかシートの指定とかが必要になると思いますが、それは、ワークシート上で、ご自身で指定してくださるようにしたほうがよいと思います。したがって、ひとつのブックにまとめるのもよいし、別々にしてもよいです。なおコードは、様子をみるために、数日を置きたいです。

>>IEに依存性があると、その2ページ目が、IEでないと正しく取れない可能性がある。
これは、IEを使わなくても可能でしたので、少なくともIEのバージョンが障害になることはありませんでした。また、IEを使わないことで、ストレスなく取得が可能になります。

>最終的には、Accessへ取り込み一括管理が目的なのですが、
>出来るかなと不安です。
本来は、直接、Access でも、インポート可能なはずです。しかし、Excel に置いて、加工するのは賢明なことかもしれません。

>(2)価格Comのレイアウト(他社を含む)の変更時の今後対処など
　ここが最大の問題点です。特に、内部のシステムの言語を変えられてしまったり、ここの掲示板のように、表の言語を変えられたら、最悪に近いです。また、価格.COMの内部のコードをみると、一定ではないようですから、ここの掲示板のように出入りが激しいところでは、難しいかもしれません。他人のコードは、読みにくいものです。ある程度、動くコードを入手したら、誰か身近で分かる人に解析してもらって、何かあった時に、その人に直してもらうという方法もあります。

できるだけ、こちらの勝手な作り込みはやめて置きますが、ただ、サイトの内部の内容が変わった時は、ご自分ではなかなか難しいです。ここの掲示板でも、私のような書き方をする人は、少ないです。ただ、一応、やり方はお教えします。

○さて、分からない部分がいくつかあります。

>必要メーカー　キヤノンEFマウント系｜ニコンFマウント系｜シグマSAマウント系

分別して出力することが出来ますが、一括して出すと、手作業の部分が必要になってしまいます。どのように出力したらよいのでしょうか？シートを別けるのが一番楽な気もします。

>>>指定されている品名が見つからないことがある。
>新製品の追加と廃盤商品の削除・更新処理が多々あります
>照らし合わせが大変です。

Webのリストでは、新製品は、ワークシートのリストにはないから見つからない、だから、新規に加えることが出来ます。しかし、廃盤商品は、どのようにして見つけるのか、それが分かりません。

補足

>必要メーカー　キヤノンEFマウント系｜ニコンFマウント系｜シグマSAマウント系
メーカーごとに五十音順でのソートで御願いしたいです。別シートでの出力の方が後の展開がしやすいと思います。Excel上でリンクすることが出来ますのでOKです。

弊社管理(4フィールド)　
Code_1 Maker_1 Maker_2　　　一覧商品名
20037　シグマ 　Canon　10-20mm F3.5 EX DC HSM
20004　シグマ 　Canon　10-20mm F4-5.6 EX DC HSM
20001　シグマ 　Canon　10mm F2.8 EX DC FISHEYE HSM
20007　シグマ 　Canon　12-24mm F4.5-5.6 EX DG ASPHERICAL HSM
20010　シグマ 　Canon　15mm F2.8 EX DG DIAGONAL FISHEYE
20025　シグマ 　Canon　17-50mm F2.8 EX DC OS HSM
20013　シグマ 　Canon　17-70mm F2.8-4 DC MACRO OS HSM
20038　シグマ 　Nikon　10-20mm F3.5 EX DC HSM
20005　シグマ 　Nikon　10-20mm F4-5.6 EX DC HSM
20002　シグマ 　Nikon　10mm F2.8 EX DC FISHEYE HSM
20008　シグマ 　Nikon　12-24mm F4.5-5.6 EX DG ASPHERICAL HSM
20011　シグマ 　Nikon　15mm F2.8 EX DG DIAGONAL FISHEYE
20026　シグマ 　Nikon　17-50mm F2.8 EX DC OS HSM
20014　シグマ 　Nikon　17-70mm F2.8-4 DC MACRO OS HSM
20039　シグマ 　Sigma　10-20mm F3.5 EX DC HSM
20006　シグマ 　Sigma　10-20mm F4-5.6 EX DC HSM
20003　シグマ 　Sigma　10mm F2.8 EX DC FISHEYE HSM
20009　シグマ 　Sigma　12-24mm F4.5-5.6 EX DG ASPHERICAL HSM
20012　シグマ 　Sigma　15mm F2.8 EX DG DIAGONAL FISHEYE
20027　シグマ 　Sigma　17-50mm F2.8 EX DC OS HSM
20015　シグマ 　Sigma　17-70mm F2.8-4 DC MACRO OS HSM

　　　　　　　　外部データ取り込み　C列
10-20mm F3.5 EX DC HSM (キヤノン用)　10-20mm F4-5.6 EX DC HSM (キヤノン AF)
10mm F2.8 EX DC FISHEYE HSM (キヤノン用)　12-24mm F4.5-5.6 EX DG ASPHERICAL HSM (キヤノン用)　15mm F2.8 EX DG DIAGONAL FISHEYE (キヤノン AF)　17-50mm F2.8 EX DC OS HSM [キヤノン用]　17-70mm F2.8-4 DC MACRO OS HSM (キヤノン用)　17-70mm F2.8-4.5 DC MACRO (キヤノン用)　18-125mm F3.8-5.6 DC OS HSM (キヤノン用)　18-200mm F3.5-6.3 DC (キヤノン AF)

>>>指定されている品名が見つからないことがある。
ここが一番の問題点で価格Comでのシステム上の誤表示　
誤　キヤノン・キヤノン(半角)・キヤノン AF・スペース挿入　入力規則が違う　( )　　　[ ]は多分新製品
正　キャノン(ゃが小文字)　教えてGooでは半角が大文字に自動変換して表示してしまいます。

>新製品は、ワークシートのリストにはないから見つからない、
一覧表のデータにない・価格未入力・Ｊ列：発売時期で見分けが出来、新規入力後に反映してくれればOKです。その場合、レコードの順が入れ替わるのでCode_1とCode_2(並べ替え)が必要になります。

>廃盤商品は、どのようにして見つけるのか、それが分かりません。
(1)Ｅ列：価格情報 - 取扱い　　店舗数を常にチェック。
(2)販売価格が急激に上がると販売店の在庫という事の推測がつく。
(3)Ｊ列：発売時期など

またご不明点はどんどん言ってください。宜しくお願いいたします。

回答No.2

DOUGLAS_

＞データ取り込み→sheet1
　お示しの ＵＲＬ の価格一覧表を [新しい Web クエリ] で取り込むと、sheet1 の

Ａ列：チェックをいれてクリック アイテムを比較する
Ｂ列：添付画像の alt属性
Ｃ列：製品名・型番
Ｄ列：価格情報 - 最安価格
Ｅ列：価格情報 - 取扱い
Ｆ列：ランキング情報 - 売れ筋
Ｇ列：ランキング情報 - 注目
Ｈ列：ランキング情報 - 満足度
Ｉ列：掲示板
Ｊ列：発売時期
Ｋ列：登録日
Ｌ列：スペック情報 - レンズタイプ
Ｍ列：スペック情報 - F値
Ｎ列：スペック情報 - 対 応 マ ウ ン ト
Ｏ列：スペック情報 - 焦点距離

というように取り込まれるようですが、

＞必要な列だけ別Sheet2にリンク
とお書きなのは、Ｃ・Ｄ列でしょうか。

　例えば、Sheet2 の 各セル に
A1　　 ： 製品名・型番
B1　　 ： 価格
A2:A55 ： =OFFSET(Sheet1!C$1,ROW()*3-1,)
B2:B55 ： =SUBSTITUTE(OFFSET(Sheet1!D$1,ROW()*3-3,),"?","")*1
という式が入っているとします。

　価格の比較をする元となる貴社の「販売価格」一覧表には、Sheet2 の Ａ列に表示されているものと同じ表記を用います。
　例えば、「EF100mm F2.8L マクロ IS USM」という文字列の場合に、
・全角・半角や大文字・小文字の相違を出さない。
・スペースの過不足がない。
というようなものにしておきます。

　ここで、貴社の「販売価格」一覧表も Sheet2 と同じ レイアウト にしておき、仮にこの一覧表が Sheet3 にあるとすると、Sheet2 の
C1　　 ： 自社価格
D1　　 ： 差額
C2　　 ： =VLOOKUP(A2,Sheet3!A:B,2,FALSE)
D2　　 ： =B2-C2
C3:D55 ： C2:D2 を オートフィル

ということで
＞更新のたびに新製品がHPページにUP(毎日変動)されると
その新製品の貴社における「製品名・型番」・「価格」を Sheet3 の末尾に追記していけば、
＞レコードがずれ
ることは起きないのではないでしょうか？

補足

早速のご回答ありがとうございました。
行き違いになって下りました。

最初にご教授頂きました所までsheetを作ってみました。

一覧表の商品数よりSheet2!B列の中かなり有ります。
以前、Sheet1より一覧表にリンク貼り付けしていたので必要のみの商品で
追加された時のレコードが駄目でした。
今度は、抽出の難題が有りそうです。

教えていただきましたSUBSTITUTEを使うと#VALUE!が出ます。
調べてみるとワイルドカードで?と*が使えないようで下記内容に変えてみました。

Sheet1　 ： 外部データ取り込み専用　A列にcode_1追加
Sheet2 ： 下記内容

A1　 ： code_1
A2　 ： 0001～連番
B1　 ： 製品名・型番
B2　 ： A2:A55 ： =OFFSET(Sheet1!D$1,ROW()*3-1,)
C1　 ： 価格
C2　 ： =MID(OFFSET(Sheet1!E$1,ROW()*3-3,),2,7)
D1　 ： 店舗
D2　 ： =OFFSET(Sheet1!F$1,ROW()*3-3,)
E1　 ： 自社
E2　 ： =VLOOKUP(B2,Sheet3!B:C,2,FALSE)
F1　 ： 差額
F1　 ： =IF(E2="","",C2-E2)
G1　 ： code_2
G2　 ： 種別メーカー分類

Sheet3 ： 一覧表　 A列： code_2　B列： 製品名・型番 C列： 価格

問題点
(1)価格Comに65件→80件、65件→50件の変動した場合、取り込み分はOKですが、
一覧表のデータと紐付けされていないので連動いたしません。
(2)ご提示頂きました件で、プロパティーでの設定ではゼロ値の非表示は有りますが、
その他の処理がわかりません。

・全角・半角や大文字・小文字の相違を出さない。
・スペースの過不足がない。

(3)価格Comでの商品名の誤表示(新旧入力方法の違い)が多々有り
一覧表でいつも訂正後をして下ります。こちらのアドレスの方がわかると思います。
http://kakaku.com/camera/camera-lens/ma_311/n1001/s3=13/
誤　キヤノン・キヤノン(半角)・キヤノン AF・スペース挿入
正　キャノン

最終形では、Accessへのインポートをしたいのです。
最初からVBAでやれば良いのですが、かなり高度な技ですよね。
データーベースの考え方になってきましたが宜しくお願いいたします。

回答No.1

Wendy02

もしかしたら、kakaku.com という名称で検索しているかもしれませんが、以下で同様の質問が出ていました。

質問番号：5657350(教えて!Goo以外でしたら、左記の番号をお使いのURLに入れ替えてください。)
http://okwave.jp/qa/q5657350.html

はなから、VBAを否定されたら、どうしようもないのですが、もう少し、細かなレイアウト的なことをおっしゃっていただければ、サンプルでやってみて可能性はあるかと思います。

たぶん、以前書いたものよりも、難しい内容になる可能性があります。
その理由は、前のものとWeb側のレイアウトが違うということもあるのですが、それ以外に

・指定されている品名を探す。
・指定されている品名が見つからないことがある。

・2ページ分を探す必要がある。
　しかし、URLの指定で、id=shop_pricemenu_makername　は、IEに依存性があると、その2ページ目が、IEでないと正しく取れない可能性がある。

ということですので、1ページ目は取れますが、2ページがなんとも言えません。なお、IEは、次第に、VBAからは使いにくくなってしまいました。変更する方法はありますが、エラーメッセージが出ることがあります。

補足

早速のご回答ありがとうございます。
教えていただきましたアドレス参考になりました。
それでは、もっと具体的に記入させていただきます。

現在、全商品(新旧)問わず取り込みをしております。
各メーカーの商品が多数あり動作を軽くするため初期段階ですが、
ファイルを分けて保存しております。
行列関数かなと思ったのですが、範囲指定が変動するため
やはりVBAの登場ですね。
最終的には、Accessへ取り込み一括管理が目的なのですが、
出来るかなと不安です。

>>指定されている品名を探す。
検索は、Excelで必要分のみリンク済みです。

>>指定されている品名が見つからないことがある。
新製品の追加と廃盤商品の削除・更新処理が多々あります
照らし合わせが大変です。

>>2ページ分を探す必要がある。
Webクエリでの取り込みでは出来ているみたいです。

>>しかし、URLの指定で、id=shop_pricemenu_makername　は、IEに依存性があると、その2ページ目が、IEでないと正しく取れない可能性がある。
50商品とそれ以上を2ページでも問題ありません。

問題点　外部データの取り込み後処理 [シグマ.xls]canon'!C4

(1)リンクセルでのフィールドの固定をした場合([シグマ.xls]canon'!$C4)、
追加分の商品のデータ取得不能→I列 差額　が誤処理結果になる

(2)価格Comのレイアウト(他社を含む)の変更時の今後対処など

必要メーカー　キヤノンEFマウント系｜ニコンFマウント系｜シグマSAマウント系
(1)http://kakaku.com/camera/camera-lens/ma_311/n1001/
　　http://kakaku.com/camera/camera-lens/ma_311/n1002/s3=13/
商品数　51品目　すべて取り込み
(2)http://kakaku.com/camera/camera-lens/ma_311/n1002/s3=13/
　　http://kakaku.com/camera/camera-lens/ma_311/n1002/s3=20/
商品数　57品目　すべて取り込み

必要項目　
A列 Code_1　 Accessでの管理コード
B列　Code_2　 外部取り込みシートの管理No
C列　商品名　　 取り込み対象列_1　[シグマ.xls]canon'!C4
D列　Maker_1　　取り込み対象列_2　[シグマ.xls]canon'!D4
E列　Maker_2　　分類No(Excel上でのフィルタ検索条件)
F列　価格情報　取り込み対象列_3　[シグマ.xls]canon'!E4
G列　店舗　　　　取り込み対象列_4　[シグマ.xls]canon'!F4
H列　New 新値を関数で数値に変換[ =MID(F2,2,7) ]
I列　 差額　　　　更新前の価格　[ =H2-J2 ]
J列　Old 更新前の価格(前日以前)

写真のアップの仕方が解らないので長文の文章なりますが
宜しくお願いいたします。