エクセル　マクロ　複数のhtmlファイルから「価格」を抽出したい

Question

全然分からず、大変困っています。宜しくお願い致します。【質問】あるフォルダーに複数のhtmlファイルがあります。その各ファイルの中に商品番号と卸価格の情報が含まれています。商品は、各ファイルごとに数10件程度ありますが、数は決まっていません。このファイル群に含まれる全ての卸価格を、エクセルに抽出するマクロを教えていただけないでしょうか。全商品番号は、「卸価格情報」というシートのA列に2行目(A2)から既に入力されています。その情報を元に、該当する卸価格を抽出し、B列の該当行にそれぞれ入力するマクロが希望です。（もし不要であれば、A列に既に入っている商品番号をご利用頂かなくても問題ございません。結果としてA列に商品番号、B列に卸価格が得られれば、方法は問いません。）【ソース】※全文は、文字数オーバーとなる為、該当部分の一部を抜き出しました。また、ソースは「株式会社名」を「あいうえお株式会社」、「リンクアドレス」を「aaaa.jp」、「商品名」をそれぞれ「商品A」「商品B」に変更した以外はオリジナルのままです。また、一例ですが、商品Aの「4971710383515」部分が商品番号です。また、その商品の「卸価格」は、そこから下方向に一番近い卸価格 203円/点(税抜)に記載されており、そこから「203」というように数値部分のみを抽出したいです。

商品A

卸価格 203円/点(税抜)

ブックマークに追加

完売御礼

商品B

卸価格 1,021円/点(税抜)

いしい · Accepted Answer

圧縮ファイルの中ではなかったのですね。
VBAで圧縮フォルダーの中から一つづつファイルを展開して処理後に削除するアルゴリズムで対策を考えていましたが、私の趣味の範囲で終わりそうです。
やはりhtmlソース内の私が見てない部分が原因かもしれませんね。
でも、htmlソースに

が含まれていれば、まともな抽出でなくても、何かは抽出されるはずなのですが…。
真っ白だった原因が気になりますが、これまでの情報だけでは難しそうです。

Javascriptの方で何とかなりそうなら、そちらを利用してもらうしかありません。
大量にファイルがある場合は、そちらだと手間がかかりそうですが、
お役に立てなくてすみません。

質問を締めてくださって結構です。
私のVBAのプログラムの問題点は、もう少し分析してから私が別に質問したいと思います。
これ以上mnmnmnoにお付き合いいただいては申し訳ありませんし…。
今回は課題を提供してくださって勉強になりました。ありがとうございました。

いしい · Answer

もし、私がアップロードしたExcelファイルで、
同じフォルダーにある「サンプル.htm」などでも、真っ白なままだと、
環境依存なのかもしれません。
文字コード違いなら、ファイル名の一覧だけは表示されます。
ちなみに、私はWindows 7のExcel 2007 です。

SHIFT-JIS用です。
http://yahoo.jp/box/5NoxCe
UTF-8用は
http://yahoo.jp/box/mibuVN

ちなみに、圧縮フォルダーの中に入ったままだと、
「表示」タブ「マクロ」グループ「マクロの表示」の「sample」で「実行」しても真っ白なままです。
ファィル数が多いということなので、圧縮フォルダーの中にある可能性も…。
ただ、２ファイルのみでも動かないということは圧縮フォルダーの中ではないでしょうから…。

いしい · Answer

失礼しました。
SHIFT-JISに変更してあったのですね。
変ですね。
私が試したサンプルHTMLは、て供された部分にヘッダ部分を付けただけなので、
他に何かあるのかな？
とりあえず、私の共有ホルダにアップロードしたので、
こちらでお試しください。
http://yahoo.jp/box/5NoxCe
SHIFT-JIS用です。
UTF-8用は
http://yahoo.jp/box/mibuVN

いしい · Answer

HTMLソースの文字コードがSIFT-JISだと、何も抽出されないです。
その場合はマクロの方のUTF-8の所をSIFT-JISに書き換えてみてください。

いしい · Answer

>「冒頭の２行目の欠落部分」(www.w3.org/TR/xhtml1/DTD/xhtml1-transitio …)

リンクになっちゃってますね。http://の後ろは
www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
です。

> 4971710383515 商品A 203
> ※上記は半角スペースで記述しましたが、欲しいのは、タブ区切りです
タブ区切りは方法が分からないです。ウェブではすべてスペースになっちゃうので…。
でも、カンマだと卸価格の３桁区切りと区別つかないですね。
卸価格からカンマを取っちゃえば良いかもしれません。
str0=item[i].innerHTML.split('/')[3]+","+Price[i].innerHTML;
を
str0=item[i].innerHTML.split('/')[3]+","+Price[i].innerHTML.replace(',', '');
にします。
また、「円/点(税抜)」を削除するのは、
str0=str0.replace('<,卸価格', ',');
の下に
str0=str0.replace('円/点(税抜)', '');
を入れます。
ウェブで表示するためにスペースを長く開けたいのなら、＆ｎｂｓｐ;を重ねれば良いのですが、お勧めできません。

ただ、タブ区切りにしたいということは、Excelでの使用を考えているのでしょうから、
やっぱり、VBAの方が良いです。Excelからコピーすればタブ区切りになりますし…。

それで、

4971710383515 商品A 203
4902424437867 商品B 1,021
（ここにコピー＆ペーストしたらタブ区切りになってます。表示は多分半角スペース）

のように表示させるマクロのプログラムを作ってみました。
自分が後々、他のことに応用することを想定していますで、コメント行があって見ずらいですが、
コピー＆ペーストすると次の通りです。
ファイル名を通し番号にしなくて済むようにもしました。
また、異常があった時に元のファイルを探せるようにＥ列をファイル名に、
卸価格がちゃんと数値になっているか確認するためにＦ列（まだ改善の余地あり）を設けました。
タブ区切りのデータが欲しければ、Ａ列からＣ列までをテキストエディタなどにコピーすれば良いと思います。

Sub sample()
Dim folder As String
Dim r As Long
Dim n As Long
Dim m As Long
Dim item(30000) As Variant '商品数以上に設定
Dim itemname(30000) As Variant '商品数以上に設定
Dim price(30000) As Variant '商品数以上に設定
Dim file(10000) As Variant 'ファイル数以上に設定
Dim str As Variant
Dim str0 As String
Dim buf As String
Dim cnt As Long 'ファイル数

folder = ThisWorkbook.Path '全てがあるフォルダ
r = 0

cnt = 0
buf = Dir(folder & "\*.htm*") '拡張子にhtmを含むファイルを一つ見つける

Do While buf <> ""
cnt = cnt + 1
file(cnt) = buf 'Dirで見つけたファイルを毎回file()に格納する
'Range("F" & cnt).Value = file(cnt) 'ファイル一覧の表示
buf = Dir() '上のDirと同じことを毎回繰り返すが、一度見つけたファイルは除外するらしい
Loop

For n = 1 To cnt 'ファイル数だけしか実行しない

With CreateObject("ADODB.Stream")
.Charset = "UTF-8" 'ファイルの文字コードを指定、シフトＪＩＳなら"SHIFT-JIS"
.Open
.LoadFromFile (folder & "\" & file(n))
str0 = .ReadText '.ReadTextのままだと問題が起きそうなので、str0にコピーした
.Close
End With

str = Split(str0, "") 'ファイルのテキストをで分割

For m = 1 To UBound(str) 'UBound関数は配列の指定された次元で使用できる添字の最大値を返す

str(m) = Split(str(m), "")(0) '分割した各ファイルのの後ろを切り捨て
item(r + m) = Split(Split(str(m), "/")(3), """")(0) 'コンパクトになった分割テキストから商品番号を抽出
itemname(r + m) = Split(Split(str(m), ">")(1), "<")(0) 'コンパクトになった分割テキストから商品名を抽出
price(r + m) = Split(Split(str(m), "卸価格")(1), "円/点(税抜)")(0) 'コンパクトになった分割テキストから卸価格を抽出

Range("A" & r + m).Value = item(r + m) '商品番号をＡ列に書き込み
Range("B" & r + m).Value = itemname(r + m) '卸価格をＢ列に書き込み
Range("C" & r + m).Value = price(r + m) '卸価格をＣ列に書き込み
Range("E" & r + m).Value = file(n) 'ファイル名をＥ列に書き込み
Range("F" & r + m).Value = "=C" & r + m & "*0" '卸価格が数値かチェック

Next

r = r + UBound(str) '次のファイルから抽出したデータを前のデータの下に書き込むため

Next
End Sub

> さっぱりわかりません。どんな本を読めばこの辺がわかるようになりますか。
本を買う金銭的余裕が無いので、ほとんどネット上の情報を利用しています。
また、コピー＆ペースト後の改造は、ちゃんと勉強してないので暗号解読に近い状態です。
見たことのない各コマンド？の使い方はネット上で検索して調べています。

いしい · Answer

またミスです。たびたびすみません。 > そこから「203」というように数値部分のみを抽出したいです。を見逃していました。 price(r + m) = Split(Split(str(m), "卸価格")(1), "")(0) を price(r + m) = Split(Split(str(m), "卸価格")(1), "円/点(税抜)")(0) か price(r + m) = Split(Split(str(m), "卸価格")(1), "円/点(税抜)")(0) に変更してください。

いしい · Answer

htmlファイルの文字コードのことも忘れていました。UTF-8であることが前提になっています。また、ファイル名を一括で連場にする方法は次のページなどに書いてあります。「Windows 7で複数のファイル名を一括で変更する方法」 http://121ware.com/qasearch/1007/app/servlet/qadoc?QID=012512&p=2 変更後のファイ名をDeleteすると" (1)"などと半角スペース付きのファイル名になります。そんなこんなで、先のプログラムを変更し、無駄を省いたら次のようになります。 Sub sample() Dim folder As String Dim r As Long Dim n As Long Dim m As Long Dim item(30000) As Variant '商品の数を設定 Dim price(30000) As Variant '商品の数と同じに Dim file(10000) As Variant 'ファイルの数を設定 Dim str As Variant Dim str0 As String folder = ThisWorkbook.Path r = 0 For n = 1 To UBound(file) file(n) = " (" & n & ").html" 'ファイル名は、" (通し番号).html" If Dir(folder & "\" & file(n)) <> "" Then With CreateObject("ADODB.Stream") .Charset = "UTF-8" 'ファイルの文字コードを指定、シフトＪＩＳなら"SHIFT-JIS" .Open .LoadFromFile (folder & "\" & file(n)) str0 = .ReadText .Close str = Split(str0, "") For m = 1 To UBound(str) str(m) = Split(str(m), "")(0) item(r + m) = Split(Split(str(m), "/")(3), """")(0) price(r + m) = Split(Split(str(m), "卸価格")(1), "")(0) Range("A" & r + m).Value = item(r + m) '商品番号をＡ列に書き込み Range("B" & r + m).Value = price(r + m) '卸価格をＢ列に書き込み Next r = r + UBound(str) End With End If Next End Sub

いしい · Answer

lastRow = Range("A" & Rows.Count).End(xlUp).Row 'A列最終行
を消し忘れました。
Ａ列の情報を利用しようとしていた時の名残です。利用するなら、その行は削除してください。
他にも消し忘れが残ってたらすみません。

いしい · Answer

ファイル数は数千でしたね。1000個で作っちゃってあります。修正は容易ですが…。
それと、データの数がトータルでいくつになるか分からないので、配列の定義？の所で長さ？数？を増やさないといけないかもしれません。

いしい · Answer

前提が一つ抜けてました。
htmlファイルがエクセルファイルと同じフォルダーにあり、拡張子がhtmlで通し番号であることが前提です。
Excelファイルにファイル名が書いてあれば、それを利用することができましたが、分からない状態で取得する方法は分かりませんでした。

エクセル マクロ 複数のhtmlファイルから「価格」を抽出したい

圧縮ファイルの中ではなかったのですね。

もし、私がアップロードしたExcelファイルで、

失礼しました。

HTMLソースの文字コードがSIFT-JISだと、何も抽出されないです。

>「冒頭の２行目の欠落部分」(www.w3.org/TR/xhtml1/DTD/xhtml1-transitio …)

またミスです。

htmlファイルの文字コードのことも忘れていました。

lastRow = Range("A" & Rows.Count).End(xlUp).Row 'A列最終行

ファイル数は数千でしたね。

前提が一つ抜けてました。

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング

エクセル　マクロ　複数のhtmlファイルから「価格」を抽出したい