Sub GetMacAddressList()

    Dim ws As Worksheet
    Dim objShell As Object
    Dim objExec As Object

    Dim strResult As String
    Dim arrLines As Variant
    Dim arrParts As Variant

    Dim i As Long
    Dim rowNum As Long
    Dim lineText As String

    Set ws = ActiveSheet

    ' 画面をクリアして見出しを作成
    ws.Cells.Clear
    ws.Range("A1:C1").Value = Array("IPアドレス", "MACアドレス", "種類")
    ws.Range("A1:C1").Font.Bold = True

    ' Windowsコマンドの実行準備
    Set objShell = CreateObject("WScript.Shell")
    ' arp -a コマンドを実行（現在のARPテーブルを表示）
    Set objExec = objShell.Exec("cmd /c arp -a")

    ' 結果をすべて読み込む
    strResult = objExec.StdOut.ReadAll

    ' 改行ごとに分割して1行ずつ処理
    arrLines = Split(strResult, vbCrLf)

    rowNum = 2

    For i = LBound(arrLines) To UBound(arrLines)
        lineText = Trim(arrLines(i))

        ' IPアドレスとMACアドレスが含まれる行か判定 (簡易パターンマッチ)
        If lineText Like "*.*.*.* *-*-*-*-*-* *" Then
            ' 連続する空白を1つに整理して分割
            arrParts = SplitBySpace(lineText)

            If UBound(arrParts) >= 2 Then
                ws.Cells(rowNum, 1).Value = arrParts(0) ' IPアドレス
                ws.Cells(rowNum, 2).Value = arrParts(1) ' MACアドレス
                ws.Cells(rowNum, 3).Value = arrParts(2) ' 種類(dynamic/static)
                rowNum = rowNum + 1
            End If
        End If
    Next i

    ws.Columns("A:C").AutoFit
    MsgBox "MACアドレス一覧を取得しました。", vbInformation

End Sub

' 連続する空白を整理して分割する補助関数
Function SplitBySpace(ByVal txt As String) As Variant
    Dim tmp As String
    tmp = Trim(txt)
    Do While InStr(tmp, "  ") > 0
        tmp = Replace(tmp, "  ", " ")
    Loop
    SplitBySpace = Split(tmp, " ")
End Function