質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

ただいまの
回答率

90.75%

  • VBA

    1635questions

    VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

  • Excel

    1397questions

    Excelは、マイクロソフト社が開発しているデータ集計や分析を行う表計算ソフトの一つです。文書作成や表計算、資料作成などの多彩な機能を備えており、統合パッケージであるMicrosoft Officeに含まれています。

  • Internet Explorer

    264questions

    Internet Explorer(IE;MSIE)はマイクロソフトが開発したウェブブラウザです。Microsoft Windowsに組み込まれています。

EXCEL VBA でセルにあるURL一覧から一括情報取得したい

解決済

回答 1

投稿 編集

  • 評価
  • クリップ 1
  • VIEW 827

njkmamagir

score 6

こんにちは、VBAを勉強していて、もう何時間も同じところで躓いており、お力をおかしいただけたらと思います。

EXCELのシートC2から下に向け100前後のURL一覧があり、各URLを開いて情報を取得しています。開くURLを直接書き込むやり方だとなんとか取れたのですが、これだと各URLをいちいち書き込まなければならず、煩雑です・・。なのでURLを書き込まず変数などにして、各URLに対して情報取得を一括でできないかと思っています。

●●できているマクロ(開くURLを直接書いているもの)●●
サブルーティンを3つつけ、一番下にメインをかいてあります。これらは本4冊とWEBの情報を参考になんとかここまではできました。

If VBA7 Then

Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As LongPtr)

Else

Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)

End If

'----------------------------------------------------------------
'①指定URLを表示するサブルーチン「ieView」
Sub ieView(objIE As InternetExplorer, _
urlName As String, _
Optional viewFlg As Boolean = True)

'IE(InternetExplorer)のオブジェクトを作成する
Set objIE = CreateObject("InternetExplorer.Application")

'IE(InternetExplorer)を表示・非表示
objIE.Visible = viewFlg

'指定したURLのページを表示する
objIE.navigate urlName

'IEが完全表示されるまで待機
Call ieCheck(objIE)

End Sub

'----------------------------------------------------------------
'②Webページ完全読込待機処理サブルーチン「ieCheck」
Sub ieCheck(objIE As InternetExplorer)

Dim timeOut As Date

timeOut = Now + TimeSerial(0, 0, 20)

Do While objIE.Busy = True Or objIE.readyState <> 4
DoEvents
Sleep 1
If Now > timeOut Then
objIE.Refresh
timeOut = Now + TimeSerial(0, 0, 20)
End If
Loop

timeOut = Now + TimeSerial(0, 0, 20)

Do While objIE.document.readyState <> "complete"
DoEvents
Sleep 1
If Now > timeOut Then
objIE.Refresh
timeOut = Now + TimeSerial(0, 0, 20)
End If
Loop

End Sub
'②お気に入りやアクセス数を変数にするもの

Function classValue(objIE As InternetExplorer, _
className As String, _
tagName As String, _
valueType As String) As String

For Each objDoc In objIE.document.getElementsByClassName(className)

With objDoc

If LCase(.nodeName) = tagName Then

Select Case valueType

Case "innerHTML"

classValue = .innerHTML

Case "innerText"

classValue = .innerText

Case "outerHTML"

classValue = .outerHTML

Case "outerText"

classValue = .outerText

End Select

Exit For

End If

End With

Next

End Function

'メインここから----------------------------------------------------------------

Sub sample()

Dim objIE  As InternetExplorer

'本サイトをIE(InternetExplorer)で起動
Call ieView(objIE, "https://www.111.com/news/22831458/")

'Aデータを抽出しI2へ
Range("I2").Value = objIE.document.getElementById("tabmenu_inqcnt").innerText

'Bデータを抽出しG2へ

Range("G2").Value = classValue(objIE, "ac_count", "span", "innerText")

'Cデータを抽出しH2へ

Range("H2").Value = classValue(objIE, "fav_count", "span", "innerText")

'画像ファイル名を抽出しK2へ

Range("K2").Value = objIE.document.images(58).src

End Sub

試したこと

https://qiita.com/Nao3/items/37f84f1777cd8229b915
↑この情報をもとに書き換えるも、うまく動作せず。

完成イメージ

URLを開くところから各情報取得→各セルへのインプットまでをループにして、URL一覧がなくなったら終了という形にしたいです。あとループにした場合、データ抽出部分をどのように書き換えるかもわからず苦戦しております・・

お力をお貸しいただけたらと思います。どうぞ宜しくお願いいたします。

補足情報(EXCEL2016,Windows10,64bit )

  • 気になる質問をクリップする

    クリップした質問は、後からいつでもマイページで確認できます。

    またクリップした質問に回答があった際、通知やメールを受け取ることができます。

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

回答 1

checkベストアンサー

+1

セル値からURL取得

まずはセル値からURLを取得する方法について。
例えばC2セルにURL https://www.111.com/news/22831458/ が入力してあり、このURLをieView関数で開くのであれば、Call ieView(objIE, Cells(2,"C").Value)という記述で実現できます。

こうすると、それ以降は今のロジックのままで、C2からURLを取得して同じ行のI/G/H/K列に書きだすような処理になりますよね。
出力側に少し手を加えるとすれば、Range関数は複数セルを指定できる記述ですが、今回は単一セルしか指定していません。
単一セルを扱うのであればCellsの方が扱いやすいです。
たとえばRange("I2").ValueCells(2,9).ValueまたはCells(2,"I").Valueと記述できます。
行番号が文字列の一部ではなくなるので、変数でループ処理することも簡単になります。

対象となるセルを順次取得する

次に課題となるのは、URLが入力されているセルの値をループ処理で順次取得する方法だと思います。
ループの範囲の決め方は例えば
・2行目~100行目までをループ処理する(固定範囲のループ)
・2行目以降、URLが連続で入力されている範囲をループ処理する
・2行目以降、URLが入力されている最終行までをループ処理する
といったようにいくつかあるのですが、ここでは3つ目に紹介した2行目~最終データ行ということで話を進めたいと思います。

C列の最終データ行はCells(Rows.Count, "C").End(xlUp).Rowといった記述で実現できます。
解説すると、Rows.Countはそのバージョンのエクセルで利用できる最大の行番号を返します。
.End(XlUp)というのは、対象セルから「Ctrl」+「↑」を操作したセル位置となります。
つまり、C列の最終行から「Ctrl」+「↑」を操作した位置の行番号を返す、というわけです。

「Ctrl」+「↑」の操作をすると、対象セルから上方向に向かって最初に見つけたデータがあるセルに移動します。
なので、C列最終行から上に向かってデータを探していき、最初に見つけた行の行番号を返す⇒最終データ行の行番号を返すという訳です。

これを使って2行目から最終データ行までのループを行えば目的の動作が実現すると思います。

Dim iRow As Integer
For iRow = 2 To Cells(Rows.Count, "C").End(xlUp).Row
    '本サイトをIE(InternetExplorer)で起動
    Call ieView(objIE, Cells(iRow, "C").Value)

    'Aデータを抽出しI2へ
    Cells(iRow, "I").Value = objIE.document.getElementById("tabmenu_inqcnt").innerText

    '(--以下略--)

Next

参考になれば幸いです。
がんばってみてください。

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2017/10/04 08:42

    jawa様、とても丁寧な回答をありがとうございます! とても分かりやすく書いていただいたお陰で、思い通りに動かすことができました!今まで時間をかけて調べていたものが一瞬でできるようになり、すごく嬉しいです!重ねてありがとうございました(^^♪

    キャンセル

15分調べてもわからないことは、teratailで質問しよう!

  • ただいまの回答率 90.75%
  • 質問をまとめることで、思考を整理して素早く解決
  • テンプレート機能で、簡単に質問をまとめられる

関連した質問

同じタグがついた質問を見る

  • VBA

    1635questions

    VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

  • Excel

    1397questions

    Excelは、マイクロソフト社が開発しているデータ集計や分析を行う表計算ソフトの一つです。文書作成や表計算、資料作成などの多彩な機能を備えており、統合パッケージであるMicrosoft Officeに含まれています。

  • Internet Explorer

    264questions

    Internet Explorer(IE;MSIE)はマイクロソフトが開発したウェブブラウザです。Microsoft Windowsに組み込まれています。