WEBページに調査する文字列が、それぞれ何件あるかをチェックしたいです。

Question

検索対象のWEBページは複数有り、日々調査するURLの個数とURLは変動するため、
Sheet1のA列にコピーしようと思います。
また、調査する文字列はSheet1 B列に記入しようと思います。
EXCEL2013のVBAで作成する方法をご教示願います。

やりたいイメージは下記となります。

 １．○月○日、3つのURLをチェック（調査対象のURLと件数は変動）

 　A列　　　　　　　　　　　　　　　　B列　　C列　　D列　　E列　　F列　　G列
1 http://www.yahoo.co.jp/○○○1　　 　　　URL1　 URL2 　URL3  URL4   URL5　　　　　　　　　　
2 http://www.msn.com/ja-jp/△△△1　  　会社　　5件 　 3件 　   6件
3 http://www.goo.ne.jp/□□□1　　　    　　新聞　　3件 　 7件 　   4件
4　　　　　　　　　　　　　　　　 　2015年　10件 　14件 　 9件
5　　　　　　　　　　　　　　　　　 　乗物　　0件 　 2件 　 0件
6　　　　　　　　　　　　　　　　　 　今後　　1件 　 3件 　 0件

※B列の実調査件数は、現在約30ですが増える場合はB列に追加していきます
※C列：1のURL件数、D列：2のURL件数、E列：3のURL件数、
　F列：4のURL件数、G列：5のURL件数
※今回検索しないURLの列は空白でなく、0件と出力されても大丈夫です

 ２．○月×日、2つのURLをチェック（調査対象のURLと件数は変動）

 　A列　　　　　　　　　　　　　　     　 B列　　C列　　D列　　E列　　F列　　G列
1　　　　　　　　　　　　　　　　　         　 　　   URL1　 URL2 　URL3  URL4   URL5　　　　　　　　　
2 http://www.msn.com/ja-jp/△△△2　 　 　会社 　 　   　　  3件  　　  　　2件
3　　　　　　　　　　　　　　　　　 　    新聞 　 　  　 　2件 　 　　 　6件
4 http://www.livedoor.com/●●●2  　  　2015年 　    　 　　 8件 　  　　　9件
5　　　　　　　　　　　　　　　　　 　    乗物 　 　  　 　1件 　 　　  　0件
6　　　　　　　　　　　　　　　　　 　    今後 　 　  　 　0件 　  　　 　1件

keronjin · Accepted Answer

再びNo,1の者です。
添付画像のようにＡ列にＵＲＬ、Ｂ列に検索キーワードが書かれている状態でコードを実行します。
※ Ａ列のＵＲＬは[A1]から下方向に書き始めて、いくつでも追加できます。
※ Ｂ列の検索語は[B2]から下方向に書き始めて、いくつでも追加できます。

あえてボタンの作り方までは書きませんが、
適当なボタンを作って下記のマクロを実行出来るようにすれば、ご希望の内容になると思います。

＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
Sub Macro1()

Dim ie As Object
Dim WebURL As String, kensaku As String, txthtml As String
Dim WordCount As Integer, N As Integer, i As Long, ii As Long

Range("A1").Select

For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row

WebURL = Cells(i, 1).Value
    If WebURL = "" Then Exit Sub
    Set ie = CreateObject("InternetExplorer.Application")
    ie.Navigate (WebURL)
    Do While ie.Busy
    Loop
    txthtml = ie.Document.body.innerHTML
    ie.Quit
    Set ie = Nothing
    Range("B2").Select

For ii = 2 To Cells(Rows.Count, 2).End(xlUp).Row
        kensaku = Cells(ii, 2).Value
        If kensaku = "" Then Exit For
        WordCount = 0
        N = 0
        Do
            N = InStr(N + 1, txthtml, kensaku)
            If (N > 0) Then WordCount = WordCount + 1
        Loop While (N > 0)
        Cells(ii, 2 + i).Value = WordCount & " 件"
    Next ii

Next i

End Sub
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

keronjin · Answer

１つのサイトを検索する例です。これを応用して自動化出来ると思いますよ。
ただし、ＨＴＭＬソースを取得して該当文字列を検索するので、プルダウンの選択項目や説明文なども全て数えてしまいます。Webページを表示した状態で数えるのとはちょっと違うのでもう一工夫必要かもしれません。

Sub Macro1()

Dim ie As Object, txthtml As String, Weburl As String
    Dim Count As Integer, N As Integer
    Dim Target, Target2
    Set ie = CreateObject("InternetExplorer.Application")

Target = Application.InputBox(prompt:="WebページのURLを入力", Title:="URL入力", Type:=2)
    If (Target = False) Or (Target = "") Then Exit Sub
    ie.Visible = True
    ie.Navigate (Target)
    Do While ie.Busy
    Loop
    txthtml = ie.Document.body.innerHTML
    ie.Quit
    Set ie = Nothing
      
    Target2 = Application.InputBox(prompt:="検索したい文字列を入力", Title:="文字列検索", Type:=2)
    If (Target2 = False) Or (Target2 = "") Then Exit Sub
    Count = 0
    N = 0
    Do
        N = InStr(N + 1, txthtml, Target2)
        If (N > 0) Then
            Count = Count + 1
        End If
    Loop While (N > 0)
    If (Count = 0) Then
        MsgBox "文字列「" & Target2 & "」は、見つかりませんでした。"
    Else
        MsgBox "文字列「" & Target2 & "」は、" & Count & "個見つかりました。"
    End If

End Sub

WEBページに調査する文字列が、それぞれ何件あるかをチェックしたいです。

再びNo,1の者です。

１つのサイトを検索する例です。

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング