![](http://oshiete.xgoo.jp/images/v2/pc/qa/question_title.png?8acaa2e)
エクセルのたとえばA列にヤフーかグーグルで検索したい飲食店(値)の名前が1,000行入っています。
それを上から順番に検索していきます。この作業はloopやfor ~ nextで対応可能だと思います。問題はここからです。
その検索した文字を、ヤフーかグーグルで検索します。検索結果で、「ヤフーロコ」、「ホットペッパー」のリンク先URL、例えばURLに”loco.yahoo.co.jp/”や”hotpepper.jp/”が入っているもののみを、B列、C列に抽出します。もし、ヤフーロコやホットペッパーの両方に、該当の飲食店がなけれが、うち1つか、もしくは該当なしとして空白のまま、次の列に行き、また検索を続けていくというものです。
自動化処理は可能でしょうか。
No.1ベストアンサー
- 回答日時:
こんばんは。
試しに、googleで調べてみました。
気になるレストラン名「ローターオクセン」(もうかつてのお店はなくなっていると思いつつ……)
を検索してみました。
「あった!」
おまけに、”loco.yahoo.co.jp/”や”hotpepper.jp/”が入っているのでした。
これなら、できますね。(^^;
VBA勉強中さんのVBAのお勉強のタシになるか分かりませんが、ちょっとコードを考えてみました。
実践的ではありませんし、雑な内容で、まだまだ修正の余地はありますが、基本的な考え方は分かっていただけるように思います。一応、検索は、1ページだけです。この辺りは、今のところ暗中模索です。
エラーを考慮していませんので、万が一には、ずれる可能性もありますので、検索値は、再び、セルに戻すようにしたほうがよいです。1,000件以上ですと、本当は、以下のようなコードはアクセス方法から変えないとダメだとは思いますが、当面のコードとしては、考え方は分かるはずです。
'//
Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
Private objIE As InternetExplorer
''参照設定:Microsoft Internet Controls
Private Hpp As Boolean
Private Lya As Boolean
Sub MainAccess()
Dim srcTxt As String
Dim n As Variant
Const BASE = "https://www.google.co.jp/" 'グーグル検索
Cells(1, 1).Resize(, 5).Value = Array("店名", "loco.Yahoo", "URL1", "ホットペッパー", "URL2")
Set objIE = New InternetExplorer
With objIE
.Visible = True ''安全だと分かったら、False 可
.Navigate2 BASE
Do While .Busy Or .ReadyState <> READYSTATE_COMPLETE
DoEvents
Loop
End With
For Each n In Range("A2", Cells(Rows.Count, 1).End(xlUp))
ieSearch n.Value, objIE
Next
objIE.Quit
Set objIE = Nothing
End Sub
Sub ieSearch(ByVal srcTxt As String, objIE As InternetExplorer)
Dim srchBx As Object
Dim srchBtn As Object
Dim iSrc As Variant
Dim v As Variant
Dim buf As String
Dim iHtml1 As String
Dim iHtml2 As String
Dim i As Long
Lya = False: iHtml1 = ""
Hpp = False: iHtml2 = ""
With objIE
Set srchBx = .Document.getElementById("lst-ib")
srchBx.Value = srcTxt
srchBx.form.Submit
Sleep 1000 'ウェイトが重すぎるかも?しかし、抜けることもある
Do
DoEvents
Loop Until .ReadyState = READYSTATE_COMPLETE
Set iSrc = .Document.getElementsByClassName("g")
If iSrc.Length > 0 Then
For Each v In iSrc
If InStr(1, v.innerHTML, "loco.yahoo.co.jp", 1) > 0 Then
Lya = True
buf = Mid(v.innerHTML, InStr(1, v.innerHTML, "href=""", 1) + 6)
iHtml1 = Left(buf, InStr(1, buf, " target", 1) - 2) & vbCrLf
End If
If InStr(1, v.innerHTML, "hotpepper.jp", 1) > 0 Then
Hpp = True
buf = Mid(v.innerHTML, InStr(1, v.innerHTML, "href=""", 1) + 6)
iHtml2 = Left(buf, InStr(1, buf, " target", 1) - 2) & vbCrLf
End If
buf = ""
Next
i = Cells(Rows.Count, 2).End(xlUp).Row + 1
'Cells(i, 1).Value = srcTxt
Cells(i, 2).Value = Lya
Cells(i, 3).Value = iHtml1
Cells(i, 4).Value = Hpp
Cells(i, 5).Value = iHtml2
End If
End With
End Sub
![「エクセルVBAで検索結果のリンク先URL」の回答画像1](http://oshiete.xgoo.jp/_/bucket/oshietegoo/images/media/c/1138040_551bfb2ee549c/M.jpg)
No.2
- 回答日時:
こんにちは。
>デバッグで
>iHtml2 = Left(buf, InStr(1, buf, " target", 1) - 2) & vbCrLf
>の部分が反転します。
実は、掲示内にアップするまで、最後の最後まで粘ったけれども、ここの部分は解決付かなかったのです。「想定内」とか言うつもりはないのですが、やはり「手抜きした所」が、もろに突かれてしまいました。(^^;
Sub MainAccess() がそのままでよいですが、次のieSearchというプロシージャは、入れ替えてください。もちろん、変更箇所を入れ替えてもよいです。ただし、まだ、エラーが出る可能性がなくなったわけではありません。On Error Resume のトラップを入れてもよいのですが、
Set r = g.getElementsByClassName("r")
ここから、
Set r_c = r(0).ChildNodes
この行に移行できる根拠などはありません。本来は、エラーチェックを入れればよいのですが、していません。たぶん、大丈夫だろうというところで進んでいます。(0)などが入る所は、本来みんな同じで、If r.Length >0 Then というチェックを入れないといけないのですが……。
>「プロシージャまたは引数が不正です」
これはよく分かりません。VBAのコードの問題のようですが……。
http://officetanaka.net/excel/vba/error/executio …
たぶん、ここと同じ話でしょうね。MidとInstr関数の組合せはやめましたから、大丈夫なはずです。
>私には難解でどこを調整したらよいのかが分かりません…。
最近、こういうのにはまっています。伝家の宝刀「FireBug」と、JavaScriptの書籍をみながらです。「FireBug」 の展開したリストから、探りを入れているというわけです。厳密には、こういうコードはVBAとも違うわけです。私も、きちんと本で勉強したらいいのですが、ナアナアなんです。
それらか、もう一つ、バグッぽい所に、
''Cells(i, 1).Value = srcTxt '検索値
があるのは、この i は、ワークシート側と繋がっていないのです。
だから、本来は、ワークシートのセルの行数を、持ってきたほうがよいのですが、直せますか?
'//
Sub ieSearch(ByVal srcTxt As String, objIE As InternetExplorer)
Dim srchBx As Object
Dim srchBtn As Object
Dim iSrc As Variant
Dim buf As String
Dim iHtml1 As String
Dim iHtml2 As String
Dim i As Long
Dim g As Object ' HTMLLIElement
Dim r, r_c
Lya = False: iHtml1 = ""
Hpp = False: iHtml2 = ""
With objIE
Set srchBx = .Document.getElementById("lst-ib")
srchBx.Value = srcTxt
srchBx.form.Submit
Sleep 1000 'ウェイトが重すぎるかも、100でも可か?
Do
DoEvents
Loop Until .ReadyState = READYSTATE_COMPLETE
Set iSrc = .Document.getElementsByClassName("g")
If iSrc.Length > 0 Then
For Each g In iSrc
If InStr(1, g.innerHTML, "loco.yahoo.co.jp", 1) > 0 Then
Lya = True
Set r = g.getElementsByClassName("r")
Set r_c = r(0).ChildNodes
iHtml1 = r_c(0).href
End If
If InStr(1, g.innerHTML, "hotpepper.jp", 1) > 0 Then
Hpp = True
Set r = g.getElementsByClassName("r")
Set r_c = r(0).ChildNodes
iHtml2 = r_c(0).href
End If
Next
i = Cells(Rows.Count, 2).End(xlUp).Row + 1
''Cells(i, 1).Value = srcTxt '検索値
Cells(i, 2).Value = Lya
Cells(i, 3).Value = iHtml1
Cells(i, 4).Value = Hpp
Cells(i, 5).Value = iHtml2
End If
End With
End Sub
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Excel(エクセル) PHPプログラムをエクセルに張り付けると検索ボックスがでてくる! 3 2022/05/08 07:10
- Excel(エクセル) Excelでの検索結果を含む行だけを表示させたい 5 2023/03/10 17:08
- Excel(エクセル) 日付で矢印マクロ 4 2023/07/25 16:47
- Visual Basic(VBA) VBA 改行コードの取り方 1 2022/03/22 14:14
- Excel(エクセル) 【Excel】指定のセル内容を基に別シートのセルを検索して選択する【VBA】 1 2022/06/16 16:16
- Visual Basic(VBA) WordのVBAについて 5 2023/01/11 14:38
- HTML・CSS Google検索も終わりですか? グーグル、検索エンジンに対話型AI搭載へ 2 2023/04/08 11:50
- Visual Basic(VBA) VBA 検索と入力 Excel ブック ぶぶぶ シート ししし 列V 検索対象の列です 最終行は、お 6 2023/05/17 01:40
- Excel(エクセル) Excelの列から検索して該当する行を別シートに転記するVBA 2 2022/12/20 09:35
- Excel(エクセル) セルの値をグーグルで検索するエクセルVBAについて! 2 2022/08/01 21:41
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
夜の8時30分ごろ、キィ、キィ、...
-
エクセルVBAで検索結果のリンク...
-
規定打席の3.1の意味。
-
豊橋市内バス釣り
-
おいしくて簡単なお料理
-
mixiのIDしか分からない人を検...
-
YAHOOのビジネスエクスプレスに...
-
「Yahoo.com」とは何ですか?Ya...
-
2010年 鳥人間コンテストのテレ...
-
カテゴリの選び方がよくわから...
-
ネットで外国の人と話したい!!
-
豆腐小僧のパンフレットを通販...
-
PSPのシリアルナンバーについて
-
18禁版のマブラヴとオルタに白...
-
カッコいい虎の画像・イラスト...
-
中学2年国語の漢語、和語教えて...
-
最近ヤフーサイトでニュース・...
-
不気味な人形探してます
-
京都 阿波踊り
-
「大ダワ」って何?
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
夜の8時30分ごろ、キィ、キィ、...
-
「Yahoo.com」とは何ですか?Ya...
-
規定打席の3.1の意味。
-
yahooブックマークでは、フォル...
-
「夢にもうかがうことのできぬ...
-
ヤフーの検索ができない
-
nslookupでIPアドレスが表示さ...
-
週間の波の高さが分かるサイト...
-
ワンウェイとはどんな意味ですか?
-
森進一の「北の蛍 」の歌詞を教...
-
電話番号からの住所検索
-
ジスピって何ですか?
-
シークレットオブエヴァンゲリ...
-
ドライバーのOD式安全テストOD...
-
読み方
-
カレン・カーペンターさんの拒...
-
名前が判りませんお願いします
-
長期金利がわかるサイト
-
mixiのIDしか分からない人を検...
-
hamilton ベンチュラのステンレ...
おすすめ情報
いち早いご回答をありがとうございます!
実際、マクロを実行させてみますと、
「Private objIE As InternetExplorer」の部分で
コンパイルエラー:
ユーザ定義型が定義されていません
と出てきてしまいますが、どういうことなのでしょうか?
WindFaller 様
上記の件は解決いたしました。
ただ再度マクロを実行すると、Googleの画面が開いた後に
「プロシージャまたは引数が不正です」
とエクセル上に出てきます。
自分でも調べてみますが、何か理由があれば教えていただけないでしょうか。
何度も申し訳ありません。
デバッグで
iHtml2 = Left(buf, InStr(1, buf, " target", 1) - 2) & vbCrLf
の部分が反転します。
ただ、私には難解でどこを調整したらよいのかが分かりません…。
WindFaller 様
自分なりに調べて解説を付けてみました。
buf = Mid(v.innerHTML, InStr(1, v.innerHTML, "href=""", 1) + 6) 'HTMLソースから、1列から始めてHTMLソースからhref=""が含まれている文字列の6文字目以降すべてが返された変数bufとする
iHtml1 = Left(buf, InStr(1, buf, " target", 1) - 2) & vbCrLf 'bufから、最初から初めてbufの中からスペースtargetを探し、そこから2文字目前までを左から返した変数をiHtml1とする
いつもありがとうございます。
Set r_c = r(0).ChildNodes
の部分がデバッグ反転し、「オブジェクト変数またはwithブロック変数が設定されていません」
と出てきてしまいます。
childNodesに関しては、ネットで調べてみましたが、「与えられた要素の子ノードの collection を返します。」とあり、説明が初めて出てくるものばかりでさっぱりです(笑)
これから勉強します。