SELECT文からスキーマ／テーブル一覧作成

Sub ExtractTablesFromSQL()
    Dim sqlText As String
    Dim resultRow As Integer
    Dim tables As Collection
    Dim table As Variant
    Dim mainWs As Worksheet
    Dim resultWs As Worksheet
    
    Set mainWs = Worksheets("メイン")
    Set tables = New Collection
    
    ' 結果出力用シートを取得または作成
    Set resultWs = GetOrCreateSheet("テーブル一覧")
    
    ' C2セルからSQL文を取得
    sqlText = Trim(mainWs.Range("C2").Value)
    
    If sqlText = "" Then
        MsgBox "メインシートのC2セルにSQL文が入力されていません。", vbExclamation
        Exit Sub
    End If
    
    ' SQL文を大文字に変換（パターンマッチング用）
    Dim sqlUpper As String
    sqlUpper = UCase(sqlText)
    
    ' 結果シートをクリアしてヘッダーを設定
    resultWs.Cells.Clear
    resultWs.Range("A1").Value = "スキーマ名"
    resultWs.Range("B1").Value = "テーブル名"
    resultWs.Range("A1:B1").Font.Bold = True
    resultRow = 2
    
    ' FROM句とJOIN句からテーブルを抽出
    Call ExtractTablesFromClause(sqlText, "FROM", tables)
    Call ExtractTablesFromClause(sqlText, "JOIN", tables)
    Call ExtractTablesFromClause(sqlText, "INNER JOIN", tables)
    Call ExtractTablesFromClause(sqlText, "LEFT JOIN", tables)
    Call ExtractTablesFromClause(sqlText, "RIGHT JOIN", tables)
    Call ExtractTablesFromClause(sqlText, "FULL JOIN", tables)
    Call ExtractTablesFromClause(sqlText, "CROSS JOIN", tables)
    
    ' 結果を出力
    For Each table In tables
        Dim parts() As String
        parts = Split(table, ".")
        
        If UBound(parts) >= 1 Then
            ' スキーマ名.テーブル名の形式
            resultWs.Range("A" & resultRow).Value = parts(0)
            resultWs.Range("B" & resultRow).Value = parts(1)
        Else
            ' テーブル名のみ
            resultWs.Range("A" & resultRow).Value = ""
            resultWs.Range("B" & resultRow).Value = parts(0)
        End If
        resultRow = resultRow + 1
    Next table
    
    ' 結果の範囲に罫線を追加
    If resultRow > 2 Then
        resultWs.Range("A1:B" & (resultRow - 1)).Borders.LineStyle = xlContinuous
        resultWs.Range("A1:B" & (resultRow - 1)).Columns.AutoFit
        ' 結果シートをアクティブにする
        resultWs.Activate
        MsgBox (resultRow - 2) & "個のテーブルが抽出され、「テーブル一覧」シートに出力されました。", vbInformation
    Else
        MsgBox "テーブルが見つかりませんでした。", vbExclamation
    End If
End Sub

Private Function GetOrCreateSheet(sheetName As String) As Worksheet
    Dim ws As Worksheet
    
    ' シートが存在するかチェック
    On Error Resume Next
    Set ws = Worksheets(sheetName)
    On Error GoTo 0
    
    ' シートが存在しない場合は作成
    If ws Is Nothing Then
        Set ws = Worksheets.Add(After:=Worksheets(Worksheets.Count))
        ws.Name = sheetName
    End If
    
    Set GetOrCreateSheet = ws
End Function

Private Sub ExtractTablesFromClause(sqlText As String, keyword As String, tables As Collection)
    Dim pos As Integer
    Dim nextPos As Integer
    Dim tableName As String
    Dim sqlUpper As String
    
    sqlUpper = UCase(sqlText)
    pos = 1
    
    ' 指定されたキーワードを検索
    Do
        pos = InStr(pos, sqlUpper, " " & keyword & " ")
        If pos = 0 Then Exit Do
        
        ' キーワードの後の位置に移動
        pos = pos + Len(keyword) + 2
        
        ' 次のテーブル名を抽出
        tableName = GetNextTableName(sqlText, pos)
        
        If tableName <> "" Then
            ' 重複チェックして追加
            If Not IsInCollection(tables, tableName) Then
                tables.Add tableName
            End If
        End If
        
        pos = pos + 1
    Loop
End Sub

Private Function GetNextTableName(sqlText As String, startPos As Integer) As String
    Dim i As Integer
    Dim char As String
    Dim tableName As String
    Dim inQuotes As Boolean
    Dim quoteChar As String
    
    ' 空白をスキップ
    For i = startPos To Len(sqlText)
        char = Mid(sqlText, i, 1)
        If char <> " " And char <> vbTab And char <> vbCrLf And char <> vbLf Then
            Exit For
        End If
    Next i
    
    If i > Len(sqlText) Then
        GetNextTableName = ""
        Exit Function
    End If
    
    ' テーブル名を抽出
    inQuotes = False
    quoteChar = ""
    
    For i = i To Len(sqlText)
        char = Mid(sqlText, i, 1)
        
        ' クォート処理
        If (char = """" Or char = "'" Or char = "[" Or char = "`") And Not inQuotes Then
            inQuotes = True
            quoteChar = char
            If char = "[" Then quoteChar = "]"
            tableName = tableName & char
        ElseIf char = quoteChar And inQuotes Then
            inQuotes = False
            tableName = tableName & char
            quoteChar = ""
        ElseIf inQuotes Then
            tableName = tableName & char
        ElseIf char = " " Or char = vbTab Or char = vbCrLf Or char = vbLf Or char = "," Or char = ")" Then
            ' テーブル名の終端
            Exit For
        Else
            ' 通常の文字
            tableName = tableName & char
        End If
    Next i
    
    ' エイリアス（AS句）を除去
    Dim words() As String
    words = Split(Trim(tableName), " ")
    If UBound(words) >= 0 Then
        tableName = words(0)
    End If
    
    ' クォートを除去
    tableName = Replace(tableName, """", "")
    tableName = Replace(tableName, "'", "")
    tableName = Replace(tableName, "[", "")
    tableName = Replace(tableName, "]", "")
    tableName = Replace(tableName, "`", "")
    
    GetNextTableName = Trim(tableName)
End Function

Private Function IsInCollection(col As Collection, item As String) As Boolean
    Dim obj As Variant
    On Error GoTo NotFound
    
    For Each obj In col
        If obj = item Then
            IsInCollection = True
            Exit Function
        End If
    Next obj
    
NotFound:
    IsInCollection = False
End Function