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

質問

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

　A列
１ 東京
２ 大阪
３ 静岡
４ 福岡

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

Google検索
東京（タブ１）｜大阪（タブ２）｜静岡（タブ３）｜福岡（タブ４）

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

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

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

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

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

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

Excel２０１６を使っています。
よろしくお願いいたします。

回答No.9

kkkkkm · ベストアンサー

回答したつもりができてなかったみたいなので再度
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

お礼

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

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

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

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

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

回答No.9

kkkkkm

いろいろ検索していたらハイパーリンクを使わない方法がありました。
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

回答No.8

kkkkkm

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

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

回答No.7

kkkkkm

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

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

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

お礼

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

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

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

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

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

回答No.6

kkkkkm

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

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

お礼

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

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

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

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

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

回答No.5

kkkkkm

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

If i = 1 Then
Application.Wait Now + TimeValue("00:00:02")
End If
を
Application.Wait Now + TimeValue("00:00:02")
だけにする。

回答No.4

kkkkkm

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

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

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

回答No.3

kkkkkm

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

お礼

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

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

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

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

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

回答No.2

yumi0215

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

回答No.1

kon555

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

https://jun1ch.com/himacroex