常連

自己紹介

### 前提・実現したいこと
以下のサイトから，病院名とWebサイトのURLを抽出するマクロを作成しています。
使用言語はVBAです。
[サイトへのリンク](https://itp.ne.jp/keyword/?keyword=%E5%8B%95%E7%89%A9%E7%97%85%E9%99%A2)

URLの抽出がうまくいかず，いろいろと調べましたが，わかりませんでした。（惜しいところまでは言っている気がするのですが…）
どなたかアドバイスいただけないでしょうか。よろしくお願いいたします。

抽出対象は，以下のようなコードがたくさん並んでいます。（病院2件分を貼り付けました）
抽出したいURLは，class="m-card-tag-button"のhref部分です。
```HTML
<li class="o-result-article-list__item" data-v-2c442e3e="" data-v-152a6b2e=""><div data-v-4839c9c6="" data-v-152a6b2e="" data-v-2c442e3e=""> <div class="m-article-card is-ad" data-v-4839c9c6=""><button class="m-article-card__toggle-favorite" style="button" data-v-4839c9c6=""><svg aria-hidden="true" focusable="false" data-prefix="fas" data-icon="heart" role="img" xmlns="http://www.w3.org/2000/svg" viewBox="0 0 512 512" class="m-article-card__toggle-favorite__icon svg-inline--fa fa-heart fa-w-16" data-v-4839c9c6=""><path fill="currentColor" d="M462.3 62.6C407.5 15.9 326 24.3 275.7 76.2L256 96.5l-19.7-20.3C186.1 24.3 104.5 15.9 49.7 62.6c-62.8 53.6-66.1 149.8-9.9 207.9l193.5 199.8c12.5 12.9 32.8 12.9 45.3 0l193.5-199.8c56.3-58.1 53-154.3-9.8-207.9z" data-v-4839c9c6="" class=""></path></svg></button> <article class="m-article-card__body" data-v-4839c9c6=""><header class="m-article-card__header" data-v-4839c9c6=""><h1 class="m-article-card__header__title" data-v-4839c9c6=""><a href="https://itp.ne.jp/info/082302344127040960/" target="_blank" class="m-article-card__header__title__link" data-v-4839c9c6="">
            ひまわり動物病院
          </a></h1>  <p class="m-article-card__header__category" data-v-4839c9c6="">
            獣医師、動物病院、ペットトリミング、ペット美容室、ペットホテル
          </p></header> <div class="m-article-card__lead" data-v-4839c9c6=""><a href="https://itp.ne.jp/info/082302344127040960/" target="_blank" class="m-article-card__lead__thumbnail u-hover" data-v-4839c9c6=""><img src="https://resources.itp.ne.jp/082302344127040960/thumb" alt="thumbnail" class="u-wh100p" data-v-4839c9c6=""></a> <div class="m-article-card__lead__body" data-v-4839c9c6=""><p class="m-article-card__lead__catch" data-v-4839c9c6="">平日夜７時　日・祝昼１２時迄
往診 トリミング ホテル 送迎</p> <p class="m-article-card__lead__caption" data-v-4839c9c6="">
            【最寄駅】東海駅
          </p> <p class="m-article-card__lead__caption" data-v-4839c9c6="">
            【電話番号】          029-270-5900
          </p> <p class="m-article-card__lead__caption" data-v-4839c9c6="">
            【住所】茨城県那珂郡東海村大字白方１７４９－４１
          </p> <div class="m-article-card__tag" data-v-4839c9c6="">  <a href="http://www.ah-himawari.com" target="_blank" class="m-card-tag-button" data-v-33370a0e="" data-v-4839c9c6=""><svg aria-hidden="true" focusable="false" data-prefix="fas" data-icon="globe" role="img" xmlns="http://www.w3.org/2000/svg" viewBox="0 0 496 512" class="svg-inline--fa fa-globe fa-w-16" data-v-33370a0e="" data-v-4839c9c6=""><path fill="currentColor" d="M336.5 160C322 70.7 287.8 8 248 8s-74 62.7-88.5 152h177zM152 256c0 22.2 1.2 43.5 3.3 64h185.3c2.1-20.5 3.3-41.8 3.3-64s-1.2-43.5-3.3-64H155.3c-2.1 20.5-3.3 41.8-3.3 64zm324.7-96c-28.6-67.9-86.5-120.4-158-141.6 24.4 33.8 41.2 84.7 50 141.6h108zM177.2 18.4C105.8 39.6 47.8 92.1 19.3 160h108c8.7-56.9 25.5-107.8 49.9-141.6zM487.4 192H372.7c2.1 21 3.3 42.5 3.3 64s-1.2 43-3.3 64h114.6c5.5-20.5 8.6-41.8 8.6-64s-3.1-43.5-8.5-64zM120 256c0-21.5 1.2-43 3.3-64H8.6C3.2 212.5 0 233.8 0 256s3.2 43.5 8.6 64h114.6c-2-21-3.2-42.5-3.2-64zm39.5 96c14.5 89.3 48.7 152 88.5 152s74-62.7 88.5-152h-177zm159.3 141.6c71.4-21.2 129.4-73.7 158-141.6h-108c-8.8 56.9-25.6 107.8-50 141.6zM19.3 352c28.6 67.9 86.5 120.4 158 141.6-24.4-33.8-41.2-84.7-50-141.6h-108z" data-v-33370a0e="" data-v-4839c9c6="" class=""></path></svg>
              ウェブサイト
              <svg aria-hidden="true" focusable="false" data-prefix="fas" data-icon="chevron-right" role="img" xmlns="http://www.w3.org/2000/svg" viewBox="0 0 320 512" class="svg-inline--fa fa-chevron-right fa-w-10" data-v-33370a0e="" data-v-4839c9c6=""><path fill="currentColor" d="M285.476 272.971L91.132 467.314c-9.373 9.373-24.569 9.373-33.941 0l-22.667-22.667c-9.357-9.357-9.375-24.522-.04-33.901L188.505 256 34.484 101.255c-9.335-9.379-9.317-24.544.04-33.901l22.667-22.667c9.373-9.373 24.569-9.373 33.941 0L285.475 239.03c9.373 9.372 9.373 24.568.001 33.941z" data-v-33370a0e="" data-v-4839c9c6="" class=""></path></svg></a></div></div></div></article></div></div></li>
<li class="o-result-article-list__item" data-v-2c442e3e="" data-v-152a6b2e=""><div data-v-4839c9c6="" data-v-152a6b2e="" data-v-2c442e3e=""> <div class="m-article-card" data-v-4839c9c6=""><button class="m-article-card__toggle-favorite" style="button" data-v-4839c9c6=""><svg aria-hidden="true" focusable="false" data-prefix="fas" data-icon="heart" role="img" xmlns="http://www.w3.org/2000/svg" viewBox="0 0 512 512" class="m-article-card__toggle-favorite__icon svg-inline--fa fa-heart fa-w-16" data-v-4839c9c6=""><path fill="currentColor" d="M462.3 62.6C407.5 15.9 326 24.3 275.7 76.2L256 96.5l-19.7-20.3C186.1 24.3 104.5 15.9 49.7 62.6c-62.8 53.6-66.1 149.8-9.9 207.9l193.5 199.8c12.5 12.9 32.8 12.9 45.3 0l193.5-199.8c56.3-58.1 53-154.3-9.8-207.9z" data-v-4839c9c6="" class=""></path></svg></button> <article class="m-article-card__body" data-v-4839c9c6=""><header class="m-article-card__header" data-v-4839c9c6=""><h1 class="m-article-card__header__title" data-v-4839c9c6=""><a href="https://itp.ne.jp/info/097120699000000899/" target="_blank" class="m-article-card__header__title__link" data-v-4839c9c6="">
            山内動物病院
          </a></h1>  </header> <div class="m-article-card__lead" data-v-4839c9c6=""><a href="https://itp.ne.jp/info/097120699000000899/" target="_blank" class="m-article-card__lead__thumbnail u-hover" data-v-4839c9c6=""><img src="https://resources.itp.ne.jp/097120699000000899/thumb" alt="thumbnail" class="u-wh100p" data-v-4839c9c6=""></a> <div class="m-article-card__lead__body" data-v-4839c9c6=""><p class="m-article-card__lead__catch" data-v-4839c9c6="">土曜日・日曜日・祝日も診療している宇都宮市の動物病院</p> <p class="m-article-card__lead__caption" data-v-4839c9c6="">
            【最寄駅】宇都宮駅 / 東武宇都宮駅
          </p> <p class="m-article-card__lead__caption" data-v-4839c9c6="">
            【電話番号】          028-622-3618
          </p> <p class="m-article-card__lead__caption" data-v-4839c9c6="">
            【住所】栃木県宇都宮市栄町４－１８
          </p> <div class="m-article-card__tag" data-v-4839c9c6="">  </div></div></div></article></div></div></li>
```

### 発生している問題・エラーメッセージ
病院名はうまく抽出できたのですが，URLがすべて同じ文字列になってしまいます。
以下は実行結果の一部です。
おがわ動物病院	https://ogawaah.net/
ハートフルおおもりのどうぶつ病院	https://ogawaah.net/
どうぶつのセンター病院	https://ogawaah.net/
小鳥のセンター病院・本院	https://ogawaah.net/
小鳥のセンター病院・池袋院	https://ogawaah.net/
菅原動物病院	https://ogawaah.net/


```
エラーメッセージは出ていません。処理自体は正常に終わっているようです。
```

### 該当のソースコード
```VBA
Sub test5()

'    検索ワード
    Dim Key As String, KeyURL As String
    Key = "動物病院"
    KeyURL = Application.WorksheetFunction.EncodeURL(Key)
        
'    IE起動
    Dim IE As InternetExplorer
    Set IE = CreateObject("InternetExplorer.Application")
    IE.Visible = True
    IE.navigate "https://itp.ne.jp/keyword/?keyword=" & KeyURL
    
    Call WaitResponse(IE)
    
'    情報取得
    Dim SearchClassName As Object, ListItem As Object
    Const OutputCol As Long = 1
    Dim OutputRow As Long
    Dim Name As String, URL As String
    OutputRow = 2
    Set SearchClassName = IE.document.getElementsByClassName("o-result-article-list__item")
    
    For Each ListItem In SearchClassName
    
'        Name
        If Not ListItem.getElementsByClassName("m-article-card__header__title")(0) Is Nothing Then
            Name = Trim(ListItem.getElementsByClassName("m-article-card__header__title")(0).innerText)
        End If
        
'        URL
        Dim Anchor As Object
        For Each Anchor In ListItem.document.Links
            If InStr(Anchor.innerText, "ウェブサイト") > 0 Then
                URL = Anchor.href
                Exit For
            End If
        Next Anchor

        Cells(OutputRow, OutputCol) = Name
        Cells(OutputRow, OutputCol + 1) = URL
        
        OutputRow = OutputRow + 1

    Next ListItem
    
    IE.Quit
    
    MsgBox "処理が完了しました。" & vbCrLf & "処理件数：" & OutputRow - 2 & "件"

End Sub
```

### 試したこと
この部分を，
```VBA
'    URL
   Dim Anchor As Object
   For Each Anchor In ListItem.document.Links
       If InStr(Anchor.innerText, "ウェブサイト") > 0 Then
           URL = Anchor.href
           Exit For
       End If
   Next Anchor
```
Fro Each ListItem In SearchClassNameの外に出して，
このように書き換えてみました。
```VBA
'    URL
    Dim Anchor As Object
    Dim j As Long
    For Each Anchor In IE.document.Links
        If InStr(Anchor.innerText, "ウェブサイト") > 0 Then
            Cells(2 + j, OutputCol + 1) = Anchor.href
            j = j + 1
        End If
    Next Anchor
```
すると，正常に動作するようにはなりましたが，
対象のWebサイトでは，病院ごとにURLの記載があったりなかったりします。
なので，病院名のセルとURLのセルの位置関係が合わなくなってしまいました。
できれば，Fro Each ListItem In SearchClassNameのなかで，ListItemごとに処理したいです。
### 補足情報（FW/ツールのバージョンなど）
- Excel2013
- Internet Explorer11