みんなの「教えて(疑問・質問)」にみんなで「答える」Q&Aコミュニティ

こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

Excelのセルをコピペして、Google検索をす

ExcelのA列にキーワードが記入されています。

 A列
1 東京
2 大阪
3 静岡
4 福岡


このA列の1~4を選択してコピペ。
コピペした1~4を↓という風に、Google検索したいです。

Google検索
東京(タブ1)|大阪(タブ2)|静岡(タブ3)|福岡(タブ4)


「Pasty」というGoogleChromeのエクステンションがあり、
それは、URLをコピペして、Google検索できるというものです。

Pastyのキーワード版で、同じようなことをしたいと思っています。


Excelのハイパーリンクで同じようなことができますが、
一つずつしかできませんし、いくつかやってると規制?で止まります。

A列にあるキーワードを効率良く、
タブで分けて、Google検索していきたいです。


Excelの式や機能、エクステンション、ツール・ソフトとかで、
Excelのセルをコピペして、Google検索をすることはできますでしょうか?

できるとしたら、どのような方法がありますでしょうか?
教えていただけたら、嬉しいです。

Excel2016を使っています。
よろしくお願いいたします。

投稿日時 - 2019-05-03 11:42:10

QNo.9613106

困ってます

質問者が選んだベストアンサー

回答したつもりができてなかったみたいなので再度
https://qiita.com/shibahead/items/c092fbd125c08b686dd9
上記を参考にしてshellにしてみました。
IEだと表示待ちができるようなのですがChromeのやりかたがわからないので一律2秒待ちにしてみました。

Sub Example2()
Dim myword As String
Dim myurl
Dim i As Long
For i = 1 To Selection.Count
myword = Selection(i).Value
myurl = "https://www.google.co.jp/search?hl=ja&source=hp&q=" & UrlEncodeUtf8(myword)
CreateObject("wscript.shell").Run myurl, 1
Application.Wait Now + TimeValue("00:00:02")
Next
End Sub


Function UrlEncodeUtf8(ByRef strSource As String) As String
Dim objSC As Object
Set objSC = CreateObject("ScriptControl")
objSC.Language = "Jscript"
UrlEncodeUtf8 = objSC.CodeObject.encodeURIComponent(strSource)
Set objSC = Nothing
End Function

投稿日時 - 2019-05-04 09:08:16

お礼

回答ありがとうございます!

ポップが出ずに、検索することができるようになりました!

途中で、ロボットでない確認の画面がありますが、
それを通れば、検索して調べることができます。

本当にありがとうございます!
これで、作業を進めることができます。

kkkkkmさん、
ありがとうございました。

投稿日時 - 2019-05-04 12:55:17

ANo.9

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(10)

ANo.9

いろいろ検索していたらハイパーリンクを使わない方法がありました。
shellで開いたら毎回新しいウィンドウで開くのだと思ってたので頭から除外してましたが、すでにブラウザが開いていると新しいタブで開きました。
Functionは検索文字列をURL用に変換するものです。
https://qiita.com/shibahead/items/c092fbd125c08b686dd9

Sub Example2()
Dim myword As String
Dim myurl
Dim i As Long
For i = 1 To Selection.Count
myword = Selection(i).Value
myurl = "https://www.google.co.jp/search?hl=ja&source=hp&q=" & UrlEncodeUtf8(myword)
CreateObject("wscript.shell").Run myurl, 1
If i = 1 Then
Application.Wait Now + TimeValue("00:00:02")
End If
Next
End Sub

Function UrlEncodeUtf8(ByRef strSource As String) As String
Dim objSC As Object
Set objSC = CreateObject("ScriptControl")
objSC.Language = "Jscript"
UrlEncodeUtf8 = objSC.CodeObject.encodeURIComponent(strSource)
Set objSC = Nothing
End Function

投稿日時 - 2019-05-04 08:34:19

ANo.8

セルにハイパーリンクを作らないでハイパーリンクすることができることが分かったのでこちらにしてみたらどうでしょう。ハイパーリンク利用してるので同じかもしれませんが…。

Sub Example()
Dim i As Long
Dim StrURL As String

If Selection.Count <> WorksheetFunction.CountA(Selection) Then
MsgBox "選択したセルにデータのないものが含まれています.", vbInformation
Exit Sub
End If
For i = 1 To Selection.Count
StrURL = "http://www.google.co.jp/search?hl=ja&source=hp&q=" & Selection(i).Value
ActiveWorkbook.FollowHyperlink Address:=StrURL, NewWindow:=True
If i = 1 Then
Application.Wait Now + TimeValue("00:00:02")
End If
Next i
End Sub

投稿日時 - 2019-05-04 07:05:46

ANo.7

> 少し時間を置きながらでないとダメなのかもしれないです。

うーん…なんなのでしょうか。
検索したら
サーバ証明書を正常な状態にしたらよかった
とか
カスペルスキーの信頼済みサイトにしたら
とか出るんですが、いつもエラーになる時の対処法みたいなので違うような感じですし…。

こちらでも何回かやってみたのですがエラーが出ないんです…。

投稿日時 - 2019-05-03 20:49:41

お礼

やはり、いくつか検索していると、
同じポップが出てきますね。

「デバッグ」を見てみると、

Range("C4").Hyperlinks(1).Follow NewWindow:=True

の部分に黄色いマーカーで表示されます。

この部分が関係しているようですが、
記述を変えたほうが良かったりするのでしょうか?

投稿日時 - 2019-05-04 06:17:45

ANo.6

すみません、あと
Next i
Set HLink = Nothing
を逆にしてください。
Set HLink = Nothing
Next i

入れるところを間違いました。
このせいかもしれません。

投稿日時 - 2019-05-03 19:14:42

お礼

Application.Wait Now + TimeValue("00:00:02")
だけにして、
Set HLink = Nothing
Next i
にしましたが、変わらず、

実行時エラー '-2146697208(800c0008)'
必要な情報をダウンロードできません。

というポップが出て来ますね。


普通にGoogle検索する分には、できるのですが、
ハイパーリンクで止まるように、マクロでも止まるようです。

少し時間を置きながらでないとダメなのかもしれないです。

投稿日時 - 2019-05-03 19:46:16

ANo.5

あと、たぶん関係ないとは思いますが、最初の2秒待ちを毎回2秒まってみたらどうなのかなとも思います。

If i = 1 Then
Application.Wait Now + TimeValue("00:00:02")
End If

Application.Wait Now + TimeValue("00:00:02")
だけにする。

投稿日時 - 2019-05-03 18:36:56

ANo.4

> これは、Google側に止められているということでしょうか?

こちら(Excel2013)で20件ほどのデータで試してみたのですがエラーにはなりませんでした。

HTTP関連のエラー (たぶんHTTP関連だと思います)関してはよくわからないのですみません。
エラーメッセージで検索するとなにかいろいろ出てくるのですが、何が相当するのかよくわかりませんでした。

投稿日時 - 2019-05-03 18:26:59

ANo.3

2013でしか動作確認していませんが
以下のような動作でしょうか(検索ワードごとに別タブで開く)
最後に1個目だけ2秒待ちを入れているのはブラウザが起動したばかりで2個目の検索を始めると1個目のタブに上書きするので。
C4は適当な作業用のセルを指定してください。
Sub Exapmple()
Dim HLink As Hyperlink
Dim i As Long

If Selection.Count <> WorksheetFunction.CountA(Selection) Then
MsgBox "選択したセルにデータのないものが含まれています.", vbInformation
Exit Sub
End If
For i = 1 To Selection.Count
Set HLink = ActiveSheet.Hyperlinks.Add(Anchor:=Range("C4"), _
Address:="http://www.google.co.jp/search?hl=ja&source=hp&q=" & Selection(i).Value, _
TextToDisplay:=Selection(i).Value)
Range("C4").Hyperlinks(1).Follow NewWindow:=True
Range("C4").Hyperlinks.Delete
Range("C4").ClearContents
If i = 1 Then
Application.Wait Now + TimeValue("00:00:02")
End If
Next i
Set HLink = Nothing
End Sub

投稿日時 - 2019-05-03 14:03:19

お礼

回答ありがとうございます!
マクロを動かしてみた所、理想の形ができました。

ただ、いくらか動かしていると、

実行時エラー '-2146697208(800c0008)'
必要な情報をダウンロードできません。

というポップが出てきます。

これは、Google側に止められているということでしょうか?
これを避けるようにするには、どのようにすればいいでしょうか?

投稿日時 - 2019-05-03 17:58:25

ANo.2

下記関数を使って結果をコピペするのはいかがでしょうか。ダブルクォーテーションは半角空白を入れています。
=CONCATENATE(A1," ",A2," ",A3," ",A4)

投稿日時 - 2019-05-03 12:32:04

ANo.1

vbaで組むのがいいんですが、個人的にはあまりVBAとブラウザ連携っていい印象がない(トラブルが多く労力がかかる)ので別解を。
外部ソフトが使用できる環境なら、フリーのキーボードマクロをオススメします。キーボード操作、マウス操作が記録できるので、工夫次第でかなり柔軟な運用ができます。

https://jun1ch.com/himacroex

投稿日時 - 2019-05-03 12:31:54

あなたにオススメの質問