後述のようなExcelのマクロを作りました。
(前略)
<h3 class="itemListContents" data-soldOutFlug="N" data-exId="6418346"><!--(商品)-->
<a href="/shop/357136/4971710383515">商品A</a></h3>
(中略1)
<strong class="fontstyle1">卸価格203円/点(税抜)</strong>
(中略2)
<h3 class="itemListContents" data-soldOutFlug="Y" data-exId="6819716"><!--(商品)-->
<a href="/shop/357136/4902424437867">商品B</a></h3>
(中略3)
<strong class="fontstyle1">卸価格1,021円/点(税抜)</strong>
(後略)
のようなソースが含まれているhtmlファイルから、ExcelのA、B、C列に
4971710383515 商品A 203
4902424437867 商品B 1,021
という結果を表示するようになっているのですが、
私の環境では正常に動作するのですが、他の人の環境で何も表示されないことがあるようです。
エラーは表示されないようです。
私が試したサンプルのhtmlファイルでは正常に動作するそうなので、
上のソースの(前略)(中略1)(中略2)(中略3)(後略)に何らかの記述があると結果が真っ白になるのかもしれません。
どのような原因が考えられますでしょうか。私の環境で再現したいです。
ちなみに、次の状態では真っ白になることを確認しています。
1. htmlファイルの文字コードがUTF-8などでSHIFT-JISではない
2. マクロを実行するExcelファイルと同じフォルダーに.htmを含むファイルが一つもない
3. htmlファイルが圧縮フォルダーの中にある。
4. htmlファイルに<!--(商品)-->が無い。
これら以外に真っ白になる原因を探しています。
また次の状態ではエラーになることを確認しています。
1. <!--(商品)-->から<!--(商品)-->までの間に/が3個ない場所がある。
もし、エラーの時にエラーメッセージを表示せずに何もしないことがあるとしたら、
真っ白な結果はエラーが原因と考えられますが、
もしもそうなら、Excelの設定でエラーメッセージを表示させない方法を教えてください。
VBAの記述でエラーをスキップさせることはできるようですが、
そうではなくて、Excelの設定で表示させない方法です。
問題の起こったマクロは次の通りです。
(On Errorステートメントを使った対処は、今後追加する予定です)
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("H" & cnt + 1).Value = file(cnt) 'ファイル一覧の表示
buf = Dir() '上のDirと同じことを毎回繰り返すが、一度見つけたファイルは除外するらしい
Loop
For n = 1 To cnt 'ファイル数だけしか実行しない
With CreateObject("ADODB.Stream")
.Charset = "SHIFT-JIS" 'ファイルの文字コードを指定、UTF-8なら"UTF-8"
.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), "<!--/.itemPrice-->")(0) '分割した各ファイルの<!--/.itemPrice-->の後ろを切り捨て
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("A1").Value = "商品番号"
Range("B1").Value = "商品名"
Range("C1").Value = "卸価格[円/点(税抜)]"
Range("D1").Value = "通し番号"
Range("E1").Value = "ファイル名"
Range("F1").Value = "卸価格チェック"
Range("G1").Value = ""
Range("H1").Value = "ファイル名一覧"
Range("A" & r + m + 1).Value = item(r + m) '商品番号をA列に書き込み
Range("B" & r + m + 1).Value = itemname(r + m) '商品名をB列に書き込み
Range("C" & r + m + 1).Value = price(r + m) '卸価格をC列に書き込み
Range("D" & r + m + 1).Value = r + m '通し番号
Range("E" & r + m + 1).Value = file(n) 'ファイル名をE列に書き込み
Range("F" & r + m + 1).Value = "=C" & r + m + 1 & "*0" '卸価格が数値かチェック
Next
r = r + UBound(str) '次のファイルから抽出したデータを前のデータの下に書き込むため
Next
End Sub
No.1ベストアンサー
- 回答日時:
こんにちは。
しばらく、前回の回答の様子を見させていただきました。
>エラーメッセージが表示されず、結果が真っ白になるケースについてです。
Split で、うまく切り分けられるものか、という不安は感じます。
これについては、正直なところ、よく分かりません。
直接の回答でなくて申し訳ありません。
今回、私も同様の状況下で回答したことがあるので、少し、コメントしたいと思いました。
私の考えていることが分かっていただけるかと思い、コメントしましたが、もしも、私の内容が不愉快でしたら、無視されて結構です。
>私の環境では正常に動作するのですが、他の人の環境で何も表示されないことがあるようです。
それについては、違うと思います。根本的に相手のHTMLデータは違うものなのです。相手は、そのことには触れずに、ただ、回答者側のマクロにエラーが出ると言っているにすぎません。本当にエラーなのか、設定でのミスなのか、またHTMLの内容について、本物はどうなっているのか何も知らされていないのではありませんか?まして、サーバーに置いているならともかく、HDDに入っているものでは、微妙な部分が違っているはずです。
これは、質問者側の良識の問題であって、回答側が考えても解決しないと思います。HTMLコードが完全でなく、こちら側で補正しなければならないようなものは、もう相手の問題について再現性など取れるとは思えません。まして本人は、VBAを知らないのでは話にならないと思います。
なお、コードの中で
str(m) = Split(str(m), "<!--/.itemPrice-->")(0)
このどこかで、Str関数が働いていませんでしょうか?Strを配列変数として用いているつもりでも、どこかで誤動作が発生していないか、少し気になります。Str関数が大きなトラブルを産むわけではありませんが、先頭に空白値が入ってしまいます。
なお、今回のデータについてはマクロを考えてみました。データなどは、前回の掲示板で、いしいさんが公開された2種類のデータ・ファイルを利用させていただきました。
http://oshiete.goo.ne.jp/qa/8960515.html
JISファイルでも、UTF8でも、どちらも可能です。
'//
Option Explicit
Private objRe As Object
Private Ar() As Variant
Sub MacroTest2()
Dim MyArray() As Variant
Dim i As Long, j As Long
Dim FName As String
Dim MyPath As String
Dim d As Variant
Dim rw As Long
Dim ItmNo
Dim Data
Dim buf As String
Dim dummy As Variant
Dim FNo As Integer
Dim TextLine As String
Set objRe = CreateObject("VBScript.RegExp")
rw = 2 '書き出しの初期値
i = 0
Range("A1").CurrentRegion.ClearContents
MyPath = ThisWorkbook.Path & "\"
Range("A1").Resize(, 7).Value = Array("商品番号", "商品名", "卸価格[円/点(税抜)]", "通し番号", "ファイル名", "卸価格チェック", "ファイル名一覧")
FName = Dir(MyPath & "*.htm?", vbNormal)
Do While FName <> ""
If FName <> "." And FName <> ".." Then
If (GetAttr(MyPath & FName) And vbNormal) = vbNormal Then
ReDim Preserve MyArray(i)
MyArray(i) = MyPath & FName
i = i + 1
End If
End If
FName = Dir
Loop
'On Error Resume Next
For Each d In MyArray
FNo = FreeFile()
Open d For Input As #FNo
Do While Not EOF(FNo)
Line Input #FNo, TextLine
If InStr(1, TextLine, "UTF-", 1) > 0 Then
UTFtoSJIs d, buf
Exit Do
Else
buf = buf & TextLine
End If
Loop
Close #FNo
Call RegPickUp(buf)
For j = 0 To UBound(Ar)
buf = Trim(Ar(0)(j))
If buf <> "" Then
Cells(rw, 1).Resize(, 2).Value = Split(buf, Space(1))
End If
On Error Resume Next
dummy = Ar(1)(j)
If Err() = 0 Then
Cells(rw, 3).Value = Val(StrConv(Ar(1)(j), vbNarrow))
End If
dummy = Empty
On Error GoTo 0
Cells(rw, 4).Value = rw - 1
Cells(rw, 5).Value = Dir(d)
rw = rw + 1
Next j
Next d
End Sub
Sub RegPickUp(ByVal htmTxt As String)
Dim Matches
Dim Match
Dim myPats As Variant
Dim Pat As Variant
Dim i As Long, j As Long
Dim buf As Variant
With objRe
.Global = True
.IgnoreCase = False
myPats = Array("/shop/\d+/(\d+)"">([^<完]+)<", "卸価格([\d,0-9?]+)\D*円/点")
For Each Pat In myPats
.Pattern = Pat
Set Matches = .Execute(htmTxt)
For Each Match In Matches
If IsObject(Match.SubMatches) Then
For i = 0 To Match.SubMatches.Count - 1
buf = buf & Space(1) & Replace(Match.SubMatches(i), ",", "")
Next
End If
buf = Trim(buf) & vbTab
Next
ReDim Preserve Ar(j)
Ar(j) = Split(buf, vbTab)
buf = ""
j = j + 1
Next
End With
End Sub
Sub UTFtoSJIs(ByVal FName As String, ByRef strTxt As String)
'http://oshiete.goo.ne.jp/qa/8960515.html の引用
With CreateObject("ADODB.Stream")
.Charset = "UTF-8"
.Open
.LoadFromFile (FName)
strTxt = .ReadText
.Close
End With
End Sub
'///
ありがとうございます。
マクロを作り慣れた人が作ると違うなぁと感じました。(^^;
サブルーチンがあって、エラー対策もしてあって…。
コピーして勉強させていただきます。
今回の件でご心配くださりありがとうございます。
今回の問いは、質問者の問題解決のためというよりも単なる私の好奇心なのです。
先の方の質問者はテキストファイルを繋げてからJavascriptを使うという、
「なるほど」と思う方法で手間を省いたみたいなので感心しています。
私がその発想を思いつかなかったのが悔しいです。
的外れな回答だったはずのJavascriptが役立って良かったです。
Javascriptを使うならブックマークレットを作った方が良かった気もしますが…。
VBAの方は、試しに作ったらできちゃったので、
誰かが回答していれば私は回答しなかったのですが、
一つの回答を持っているのに回答しないのは申し訳ない気がして、
Javascriptを使った手間のかかる方法を回答をしてしまった申し訳なさもあり、
つい回答しちゃいました。
エラー対策もしてない雑なマクロで質問者に付き合わせちゃって申し訳なかったです。
これ以上私の好奇心に付き合ってもらうのは申し訳なかったので質問を締めてもらいました。
その代り、気になることが残ったので、私の質問として「教えて!goo」に投稿しました。
投稿後、私のマクロではエラーが多発しそうなことが分かりました。
テンプレートを使って表示するテキスト部分だけを変えたhtmlファイルって、
無駄な部分を残したままのことが多いでしょうから。
私のマクロは自分用には良いのですが、
身近にいない他人に提供するようなものではありませんでした。反省してます。
エラー無しに真っ白になる原因は、
私が経験したのは質問に書いたくらいなので、
他に経験者がいれば教えてほしいと思いました。
エラーが起こってもエラーメッセージを出さずに無視する設定は、
ありそうなので、知っている人がいれば教えてほしいと思いました。
エラーメッセージを出さずに、全てのマクロを無視する設定はあるようですが…。
長くなりましたが、そんな事情です。
今は先の質問者の問題ではなく、私の問題になっています。
Str関数の件、マクロを書く前にちゃんと確認してませんでした。勉強します。
ありがとうございました。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) このVBAでExcelアプリケーションを作成は必要ですか? 3 2023/07/19 21:13
- Excel(エクセル) 2つのVBAを一緒にしたら機能しなくなりました(エクセル) 7 2022/06/02 12:41
- Excel(エクセル) Excelにて、フォルダ内のTextファイルをマクロで統合すると文字化けしてしまう時の解消コード 4 2023/01/01 07:32
- Visual Basic(VBA) 別シートのデータを参照して値を入れたい。 まとめデータシートのC列D列の値を商品一覧シートのコードが 7 2022/08/17 13:20
- Excel(エクセル) Excel VBAどこが間違ってますか? 4 2023/07/17 10:04
- Visual Basic(VBA) 3つのプロシージャをまとめたら実行時エラー発生で対応不能 6 2022/05/17 01:47
- Visual Basic(VBA) エクセルのマクロを使ってメールを送る方法について教えてください 2 2022/03/29 01:36
- Visual Basic(VBA) VBAコードが作動せず、どこに問題があるのか教えて下さい。 3 2023/06/13 13:20
- Visual Basic(VBA) VBA 税率を判定表する方法を教えて下さい。 10 2022/03/28 11:21
- Visual Basic(VBA) 配列の勉強をしています。使用する変数の意味、検索条件の書き方が難しいです。 2 2022/09/15 14:06
関連するカテゴリからQ&Aを探す
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
エクセルVBAでセルに入力したパ...
-
excelに貼り付けた数値が勝手に...
-
Teraマクロで日付ディレクトリ...
-
EXCELファイルが開けない(-_-;)
-
エクセル 一括リンクの解除
-
VLOOKUP関数とネットワークに置...
-
検索結果をテキスト吐き出し
-
EXCELのVBAで画像を選んだ順に...
-
ファイルを並び替えるときの「...
-
EXCELのハイパーリンクの編集を...
-
Excel VBAで自動的にハイパーリ...
-
ファイル名を置き換えるやり方...
-
複数のHTMLファイルの中身にお...
-
エディタで効率的な切り出し方法
-
エクセル:フォルダ内のファイ...
-
エクセルを選択して開き印刷す...
-
VB6.0で、APIのファイルを開く...
-
EXCELで複数のファイルから抽出
-
ローマ字→カタカナへ変換(エク...
-
スクロールしてもボタンを常に...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
エクセルVBAでセルに入力したパ...
-
excelに貼り付けた数値が勝手に...
-
【マクロ】シート名を取得する...
-
Teraマクロで日付ディレクトリ...
-
EXCELのVBAで画像を選んだ順に...
-
VLOOKUP関数とネットワークに置...
-
ファイルを並び替えるときの「...
-
エクセル 一括リンクの解除
-
EXCELのマクロを使って、テキス...
-
EXCELで複数のファイルから抽出
-
excel INDIRECT 他ファイル参照
-
エクセルからスキャナVBAで連動...
-
ハイパーリンクで前回値をひき...
-
エクセルファイルから指定した...
-
CSVで文字化けしてしまうのを直...
-
PDF ファイルが開けません。
-
Excelでリンクを使用すると#N/A...
-
=CELL("filename")で取得したフ...
-
エクセル:フォルダ内のファイ...
-
Excelvbaで同一フォルダー内の...
おすすめ情報
現在は
Sub sample()
の直後に
On Error Resume Next
を入れてあります。
これで、
「1. <!--(商品)-->から<!--(商品)-->までの間に/が3個ない場所がある。」
場合にもエラーメッセージを表示しなくなりました。
質問は、On Error Resume Next などエラー対策が記述されて無い状態で、
エラーメッセージが表示されず、結果が真っ白になるケースについてです。
> また次の状態ではエラーになることを確認しています。
>
> 1. <!--(商品)-->から<!--(商品)-->までの間に/が3個ない場所がある。
他にもエラーになる原因として、
2. <!--(商品)-->から<!--(商品)-->までの間に「>」が一つもない。
3. <!--(商品)-->から<!--(商品)-->までの間に「卸価格」が一つもない。
を確認しています。
だから、
<!--(商品)-->
<!--(商品)-->
<!--(商品)-->
のように<!--(商品)-->が並んでいるだけの所があるとエラーになることは分かりました。
たぶん、マクロのエラーを表示させない設定があると思うのですが、
Excelのオプションを探しても見つかりませんでした。
どこにあるか、教えてください。
WindFallerさんの回答で、
「str(m) = Split(str(m), "<!--/.itemPrice-->")(0)」が怪しくなってきました。
str(m)でmの値を文字列に変換しただけなら、<!--/.itemPrice-->が無いだけでなく、
ほとんど空白のテキストです。データはmの値がテキストになっただけです。
もしもそうなら、その結果がエラーを出さずに真っ白になっても変ではありません。
すぐに再現できそうにありませんが、余裕ができたら検討したいと思います。
「Excelのマクロを実行しても、エラーメッセージもなく結果が真っ白」を実現しました。
やはり文字コードの問題でした。
Windows標準のテキストエディタ「メモ帳」でhtmlファイルを作ることにより実現しました。
私が使っていたテキストエディタでは他の文字コードはSHIFT-JISですが、
その中に次のような文字があると、真っ白な結果でした。
ⒶⒷⒸⒹ
丸A、丸B、丸C、丸Dなどです。
ウェブページからこれらの文字を拾ってきてhtmlファイルのコピーし、「メモ帳」で保存しようとするとこれらの文字を残したければUnicodeで保存するように注意されたのでそうしました。
他のテキストエディタで開くと?で表示されて気付かないです。
これらの文字があるhtmlで私が作ったマクロを実行すると、結果は、エラーを表示せずに真っ白でした。
str(m)がどんな文字になっているかは確認できませんでした。
答えが見つかったと思いますので、この質問を閉じます。
WindFallerさん、その他、読んでくださった方々、
ありがとうございました。