大量のFQDNから一括でドメイン名を抜き出したい【Excel VBA】

見出し



【FQDNからドメイン名を抜き出したい】

アクセスログなどのFQDNの一覧から、ドメイン名を抜き出したい(サブドメインを省きたい)ケースがあります。
私としては、主にサブドメインによってソートなどが阻害されてしまうケースが多いです。

例:「drive.google.com」「mail.google.com」「map.google.com
⇒全て、ドメイン名「google.com」とみなしたい。

最初はエクセルの関数で実現しようと考えましたが、条件分岐が多すぎて煩雑だったので、VBAで実装することにしました。
ゴリゴリとIFで分岐していきます。

【サンプルコード】

Option Explicit

'セルA1以下に並ぶFQDN一覧からドメイン部を抽出して、新しいワークブックに出力する。
Sub domain_from_fqdn()
  
  Dim i, maxnum As Long
  Dim tmp As String
  Dim fqdn, domain As Variant
  
  'もしデータがない場合は、処理を終了
  If Cells(1, 1) = "" Then Exit Sub
  
  '最終行番号を取得(空白まで)
  If Cells(2, 1) = "" Then
    maxnum = 1
  Else
    maxnum = Cells(1, 1).End(xlDown).Row
  End If
  ReDim fqdn(1 To maxnum)
  ReDim domain(1 To maxnum)

  '====================================================
  'FQDN一覧に対して、条件に従ってドメイン部を抜き出す。
  
  '1行目以降
  Do
    If i > maxnum Then Exit Do
    
    tmp = Cells(i, 1)
    fqdn(i) = tmp
  
    '[1] 条件:IPアドレス
    '  結果:そのまま返す
    If IsNumeric(Replace(tmp, ".", "")) Then
      domain(i) = tmp
  
    '[2] 条件:含まれるドットが1つ以下(サブドメインが無い)
    '  結果:そのまま返す
    ElseIf (Len(tmp) - Len(Replace(tmp, ".", ""))) <= 1 Then
      domain(i) = tmp
    
    '[3] 条件:属性型JPドメイン
    ElseIf Right(tmp, 6) = ".ac.jp" Or Right(tmp, 6) = ".ad.jp" Or Right(tmp, 6) = ".co.jp" _
    Or Right(tmp, 6) = ".ed.jp" Or Right(tmp, 6) = ".go.jp" Or Right(tmp, 6) = ".gr.jp" _
    Or Right(tmp, 6) = ".lg.jp" Or Right(tmp, 6) = ".ne.jp" Or Right(tmp, 6) = ".or.jp" Then
      
      '[3-1] 条件:さらに、ドットを2つ含む(サブドメインが無い)
      '    結果:そのまま返す
      If (Len(tmp) - Len(Replace(tmp, ".", ""))) = 2 Then
        domain(i) = tmp
      
      '[3-2] 条件:さらに、ドットを3つ以上含む
      '    結果:右から3つ目のドット以降
      Else
        tmp = Mid(tmp, InStrRev(tmp, ".", InStrRev(tmp, ".", InStrRev(tmp, ".") - 1) - 1) + 1)
        domain(i) = tmp
      
      End If
      
    '[4] 条件:それ以外
    '  結果:右から2つ目のドット以降
    Else
      tmp = Mid(tmp, InStrRev(tmp, ".", InStrRev(tmp, ".") - 1) + 1)
      domain(i) = tmp
    
    End If
  
    i = i + 1
  Loop
  
  '====================================================
  'ここから新ワークブックがアクティブ
  Dim wb As Workbook
  Dim ws As Worksheet
  Set wb = Workbooks.Add
  Set ws = wb.Worksheets(1)
  With ws
    .Range(.Cells(1 + 1, 1), .Cells(maxnum + 1, 1)) = WorksheetFunction.Transpose(fqdn)
    .Range(.Cells(1 + 1, 2), .Cells(maxnum + 1, 2)) = WorksheetFunction.Transpose(domain)
    .Cells(1, 1) = "【FQDN】"
    .Cells(1, 2) = "【ドメイン部】"
    .Activate
  End With

End Sub

【解説】

前提として、セルA1から下に、途切れることなくFQDNの一覧を並べます。
その状態で上のマクロを実行することで、A列の各FQDNに対して、以下のそれぞれの条件によってドメイン名を抽出します。
最終的に、結果を新規ワークブックに出力します。


1.FQDNではなくIPアドレスの場合。
⇒ そのまま。
(例)127.0.0.1 ⇒ 127.0.0.1

2.含まれるドットが1つ以下の場合(サブドメインが無い)
⇒ そのまま。
(例)localhost ⇒ localhost
(例)example.com ⇒ example.com

3-1.属性型JPドメインを含み、ドットを2つ含む場合(サブドメインが無い)
⇒ そのまま。
(例)paypay.ne.jp ⇒ paypay.ne.jp

3-2.属性型JPドメインを含み、ドットを3つ以上含む場合(サブドメインを省く)
⇒ 右から3つ目のドット以降を抜き出す。
(例)www.yahoo.co.jp ⇒ yahoo.co.jp

4.上記以外の場合(サブドメインを省く)
⇒ 右から2つ目のドット以降を抜き出す。
(例)support.office.microsoft.com ⇒ microsoft.com


なお上の条件は、主に日本の環境を前提としています。
例えば「www.google.co.uk」などのFQDNに対して、上の条件ではサードレベルドメインが省かれて「co.uk」になってしまいますが、日本では稀なケースだと想定して無視しています。