いよいよ、クライマックスです。
過去3回の記事をおさらいしておいてくださいね。
今回の処理の概要は、次のとおりです。
「表の検索キーワードを使って、Googleで検索を行い、検索結果の総数をF列に代入する」
今回の表は、10行ありますので、繰り返し処理を行います。
それでは、プログラムの処理を確認しましょう。
1.表のシート（今回は、「Sheet1」です）の3行目の検索キーワードを含んだURLを生成する
2.エクセルの機能「新しいWebクエリ」を使って、別のシート（今回は、「Sheet2」です）にデータを取り込む
3.取り込んだデータの中から、検索結果の総数を取得して（自作関数を使用）、表のF列3行目に代入する
4.上記1～4の手順を、表の最終行まで、繰り返す（今回は10回）
5.取り込みの際に自動的に生成される 名前 を全部削除する（サブルーチンとして作成しました）
手順5について説明をしておきます。
データを取り込むごとに、名前が自動生成されてしまいます。
これは、増える一方です。
パソコンの性能によりますが、この名前があまり多くなると、とたんに処理が遅くなります。
パソコンによっては、動かなくなることもあります。
それを避けるために、処理の最後に、この名前を全部削除しているのです。
今回は、この処理を独立したプロシージャとしてつくりました。
名前は、DeleteNameとしました。
いくつあるか分からない名前を全部削除するには、For Each ～ Next構文を使うと簡単です。
詳しくは、下のコードをご覧ください。
それでは、標準モジュールに記述するコードを確認します。
3つのプロシージャ（プログラムの単位）がありますよ。
Sub 検索件数の取得()
Dim qs As String
Dim i As Integer
Dim LastRow As Integer
Sheets(1).Select
'最終行を取得
LastRow = Range("B65536").End(xlUp).Row
For i = 3 To LastRow
Sheets(1).Select
'検索キーワードを含んだURLを生成する
qs = "http://www.google.co.jp/search?hl=ja&source=hp&q="
qs = qs & Range("C" & i).Value & " "
qs = qs & Range("D" & i).Value & " "
qs = qs & Range("E" & i).Value
qs = qs & "&btnG=Google+%E6%A4%9C%E7%B4%A2&lr=&aq=f&aqi=g8g-r2&aql=&oq=&gs_rfai="
Sheets(2).Cells.Clear
'データを取り込む（メイン処理）特に2行下のコードに注目。qs がURL です。
With Sheets(2).QueryTables.Add(Connection:= _
"URL;" & qs, Destination:=Sheets(2).Range("A1"))
.Name = "google"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
'取り込んだデータの中から、検索結果の総数を取り出す
'別途作成した 自作関数を使用する
Sheets(1).Range("F" & i).Value = GetKensu
Next
'サブルーチンを実行する
DeleteName
Sheets(1).Select
End Sub
Function GetKensu() As String
'自作関数：取り込んだデータから検索結果の総数を取得する
Dim i As Integer
Dim LastRow As Integer
Dim StartPoint As Integer, EndPoint As Integer
'定数に、今回は、「検索結果」を設定する
Const StartKeyWord As String = "検索結果"
Sheets(2).Select
'最終行を見つける
LastRow = Range("A65536").End(xlUp).Row
For i = 1 To LastRow
'行に、「検索結果」という文字があるかどうかをチェック。
StartPoint = InStr(Range("A" & i).Value, StartKeyWord)
If StartPoint > 0 Then
'見つかった場合の処理（見つかると、行頭からの文字数を返す）
EndPoint = InStr(Range("A" & i).Value, "件中")
'「件中」という文字までの間に、検索件数の数字が存在する
GetKensu = Mid(Range("a" & i).Value, _
StartPoint + Len(StartKeyWord), _
EndPoint - (StartPoint + Len(StartKeyWord)))
'「検索結果」と「件中」の間の文字を取得
GetKensu = Replace(GetKensu, "約", "")
'「約」という文字を削除（こういう場合に、置換を使用する）
GetKensu = Trim(GetKensu)
'一応、数値の両端の空白を除去しておく
Exit Function
End If
Next
GetKensu = "なし"
'もし、検索結果の数値が見つからなかった場合の、この関数の答え
End Function
Sub DeleteName()
Dim n As Name
For Each n In Names
n.Delete
Next
End Sub
画像を載せておきます。
それでは、プログラムを実行してみましょう。
「ツール」「マクロ」「マクロ」で、「マクロ」ダイアログボックスを表示します。
Altキーを押しながら、F8キーを押してもいいですよ。
検索件数の取得 を選択して、実行ボタンを押してください。
すると、F列に、順次、数字が代入されていきます。
大体、1秒おきくらいのペースで、代入されていきますが、
ネットの通信状況等で、もっと遅くなるかもしれません。
しばらく、眺めていてやってください。
ほら、完了しました。
今回のシリーズは、いくつものステップに分けて、最終的に目的を達成しました。
そのステップごとに、プロシージャをつくり、それを呼び出して処理するようにすると、
プログラム全体の見通しがよくなります。
今回の場合では、繰り返し、データを取り込むプログラムが主となりますが、
その中で、取り込んだデータから検索結果の総数を取得するプログラムまで記述すると、
プログラムが長くなり、分かりにくくなってしまいます。
そこで、取り込んだデータから検索結果の総数を取得する部分を、別途関数として
独立したプロシージャとすることによって、ロジックとしても、処理の流れとしても
可読性の高いプログラムとなります。
同様に、名前の一括削除も、独立させて、呼び出すようにしました。
「困難は、分割せよ」ということわざがあります。
プログラムを作るのにも、たいへん有用な言葉です。
それでは、また。
だい
アクセス
トータル
ランキング
』と併せて読むとさらに効果的です。
