ＶＢＡに関して質問です。
エクセルのマクロを使用して、自分が調べたいキーワードを含む文をホームページから抜き出し、記録したいと考えています。
実際には、Ａ列にホームページのＵＲＬ、Ｂ列にキーワード、Ｃ列にキーワードを含む文を保存する場所を用意します。
マクロを起動すると、
１：Ａ列のＵＲＬを読み込みインターネットエクスプローラーで移動する。
２：Ｂ列のキーワードを含む文を抜き出す。
’キーワードを含む文の前の文の終りの。からキーワードを含む文の終りの。までを抜き出したいです。
３：その抜き出した値をＣ列に入れる。
コードを書いて頂けた場合は少ないですが、５００ｐｔ送らせていただきます。
もし無理な場合は自分なりに書いたコードを一部修正していただけると嬉しいです。
ご回答お待ちしております。
※ 有料アンケート・ポイント付き質問機能は2023年2月28日に終了しました。
ログインして回答する
みんなの回答
-
うぃんど
満足250pt
私ならばIEを起動せずに直接取得します
作って動作させたコードを載せてますが、
検索パターンは対象としているサイトの内部構造にあわせる必要がありますOption Explicit Sub MySearch() ' 'メインとして呼び出すマクロ ' ' 定数 Const targetList = "A": 'URLの入っている列 Const searchKeyward = "B": '検索キーワードの入っている列 Const resultText = "C": '結果を格納する列 ' 変数準備 Dim startRow As Long, lastRow As Long startRow = 2: ' コメント欄のコードにあわせてA2からURLが記載されているものとする 'このマクロはアクティブなシートを対象として動作するものとする With ActiveSheet lastRow = .Cells(.Rows.Count, targetList).End(xlUp).Row: 'URLの列を見てデータの最終行を求める If lastRow < startRow Then Exit Sub: 'URLの記載が無ければプログラム終了 '作業ループ Dim nowRow As Long: '作業中の行（ループで使用するため初期値ありません） For nowRow = startRow To lastRow .Cells(nowRow, resultText).Value = MyHttpRequest(.Cells(nowRow, targetList).Value, .Cells(nowRow, searchKeyward).Value) Next nowRow End With '終了メッセージ MsgBox "終了しました" End Sub Function MyHttpRequest(targetURL As String, searchKeyward As String) As String ' サイトからキーワードを含む文字列を抜き出す関数 ' 変数準備 Dim x As Object, r As Object, m As Variant 'バインディング Set x = CreateObject("MSXML2.XMLHTTP") Set r = CreateObject("VBScript.RegExp") '情報取得 x.Open "GET", targetURL, False x.send (Null) '抽出 r.Pattern = "。.*?" & searchKeyward & ".*?。": '抽出パターン r.IgnoreCase = True: '大文字小文字を区別しない r.Global = False: '最初に見つかった文字列だけを対象とする Set m = r.Execute(x.responseText): '実行 If m.Count > 0 Then MyHttpRequest = Mid(m(0).Value, 2) Else MyHttpRequest = "見つかりませんでした" End If ' 開放 Set m = Nothing Set r = Nothing Set x = Nothing End Function
情報収集部分を関数として分離してありますので、
どの部分で何を行っているのかを理解しやすいと思いますし、
サイトにあわせて関数を複数種類用意するということも容易になろうかと思います
IEを起動して操作するという動作コストが高すぎるため、
コメント欄のコードは情報収集用途には向きませんし、
適当に繋ぎ合わせてあるため、修正すべき点も多く、修正は行ってません -
- その他の回答を読む
この質問へのコメント
質問の情報
- 登録日時
- 2011-12-24 09:20:22
- 終了日時
- 2011-12-31 09:25:02
- 回答条件
- 1人5回まで
この質問のカテゴリ
この質問に含まれるキーワード
人気の質問
-
この英文どうなってますか？ The boy seemed to be waiting for his mother to come.（その少年は母親が来…
匿名質問者
3
1
-
不定詞の形容詞的用法らしいんですけど、副詞的用法と書いたら✖️ですか？ I want to buy a book to read …匿名質問者11
-
日向陽葵という○V女優が好きなのですが似ている○V女優はいますか匿名質問者
-
共通テストで使われるプログラミング言語は共通テスト特有の言語と聞いたのですが、受験勉強で身につけたプ…匿名質問者21
-
内定してほしいポケモンはいますか？匿名質問者
Sub Macro1()
Const BASE_URL As String ="Ａ"
Set objIE = CreateObject("InternetExplorer.Application")
objIE.Visible = True
Range("A1").Select
Do Until ActiveCell.Value = ""
Dim url As String
url = Replace(BASE_URL, "A")
ActiveCell.Offset(1, 0).Activate
objIE.Navigate2 url
While objIE.ReadyState <> READYSTATE_COMPLETE Or objIE.Busy = True
Sleep 200
Wend
Dim MyHtml As Variant
Debug.Print "開始"
MyHtml = objIE.Document.body.innerHTML
Dim re As Object
Dim mc As Object
Dim i As Variant
Set re = New RegExp
i = ActiveCell.Row
re.Pattern = "。(.*?)"B"(.*?)。"
re.IgnoreCase = True:
re.Global = True:
Set mc = re.Execute(MyHtml)
If mc.Count >= 1 Then Cells(i - 1, "C").Value = mc(0).SubMatches(0)
Loop
End Sub
http://q.hatena.ne.jp/1324686021
このページを
はてな
で検索すると・・・。