소개

사용법

엑셀에 다음과 같은 표를 만든다.

Option Explicit
Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)
Sub NichibenrenSearch()
    On Error GoTo continue
    '行を数える
    Dim dataCnt As Long 'データ数
    dataCnt = Cells(Rows.Count, 2).End(xlUp).Row

    Dim target As Long '検索対象の行
    Dim startNum As Long '開始行
    startNum = InputBox("開始行は？")
    For target = startNum To dataCnt '開始行～データ数

        '起動
        Dim objIE As InternetExplorer
        Set objIE = New InternetExplorer

        objIE.Visible = True
        objIE.navigate "https://www.nichibenren.jp/member_general/lawyerandcorpsearchselect/lawyerInfoSearchInput/"

        Call WaitResponse(objIE)

        '検索
        Dim htmlDoc As HTMLDocument
        Set htmlDoc = objIE.document

        Dim targetLast As String
        Dim targetFirst As String

        targetLast = Cells(target, 2).Value
        targetFirst = Cells(target, 3).Value

        With htmlDoc
            .getElementById("last_name").Value = targetLast
            .getElementById("first_name").Value = targetFirst
            .getElementById("doLawyerInfoSearch").Click
        End With

        Call WaitResponse(objIE)

        '検索結果が0なら終了
        If tagCheck(objIE, "class", "text-right", "0") = True Then
            Cells(target, 6) = "◆該当なし"
            GoTo continue
        End If

        '検索結果一覧の一番上へ遷移
        'tableの2行目（tr(1)），2列目（td(1)），子（a）を取得。tdだけだとなぜかthもカウントされてうまくいかない
        htmlDoc.getElementsByTagName("tr")(1).getElementsByTagName("td")(1).Children(0).Click

        Call WaitResponse(objIE)

        '詳細情報取得
        '上の表
        Dim table1 As Object
        Set table1 = htmlDoc.getElementsByTagName("table")(0)

        Dim x As Long '上の表の列
        For x = 0 To 4 '5列分
            Cells(target, x + 5) = table1.Rows(1).Cells(x).innerText '行（rows）は2行目で固定，列（cells）は変動
        Next

        '下の表
        Dim table2 As Object
        Set table2 = htmlDoc.getElementsByTagName("table")(1)

        Dim y As Long '下の表の行
        For y = 0 To 7 '8行分
            Cells(target, y + 10) = table2.Rows(y).Cells(1).innerText '行（rows）は変動，列（cells）は2行目で固定
        Next

continue:
        objIE.Quit
    Next
    Beep
    MsgBox "完了"
End Sub

Sub WaitResponse(objIE As Object)
    Dim i As Long
    For i = 0 To 10
        Do While objIE.Busy = True Or objIE.readyState <> READYSTATE_COMPLETE '読み込み待ち
            DoEvents
        Loop
        Sleep 100 '追加で待ってあげないとうまくいかない
    Next
End Sub

Function tagCheck(objIE As InternetExplorer, _
                 methodType As String, _
                 elementName As String, _
                 keywords As String) As Boolean
  Dim objDoc  As Object, myDoc  As Object
  tagCheck = False
  Select Case methodType
    Case "name"
      Set objDoc = objIE.document.getElementsByName(elementName)
    Case "class"
      Set objDoc = objIE.document.getElementsByClassName(elementName)
    Case "tag"
      Set objDoc = objIE.document.getElementsByTagName(elementName)
  End Select
  For Each myDoc In objDoc
    If InStr(myDoc.outerHTML, keywords) > 0 Then
      tagCheck = True
      Exit For
    End If
  Next
End Function

보충

=LEFT([@氏名],[@氏字数／修正])
=RIGHT([@氏名],LEN([@氏名])-[@氏字数／修正])

갱신의 여지

=IF(AND([@氏名2]<>"",[@氏名2]<>[@氏]&" "&[@名],[@済]=""),"◆要確認","")