- Alt + F11 で VBA エディタを開く
- 挿入 → 標準モジュール → 上記コードを貼り付け
- Excel に戻って、整形したい SQL が入ったセル（または範囲）を選択
- Alt + F8 → FormatSqlInSelection を実行
Option Explicit
' ==== 公開関数 ============================================
' 単一文字列の SQL を整形
Public Function FormatSql(ByVal sql As String) As String
Dim tokens As Collection
Dim result As String
Set tokens = TokenizeSql(sql)
result = BuildFormattedSql(tokens)
FormatSql = result
End Function
' 選択セル内の SQL をまとめて整形
Public Sub FormatSqlInSelection()
Dim c As Range
If Selection Is Nothing Then Exit Sub
For Each c In Selection.Cells
If Not IsEmpty(c.Value) Then
On Error Resume Next
c.Value = FormatSql(CStr(c.Value))
On Error GoTo 0
End If
Next c
End Sub
' ==== トークナイザ ========================================
' SQL をトークン列に分解（文字列リテラルも考慮）
' SQL をトークン列に分解（文字列リテラル & ブロックコメントも考慮）
Private Function TokenizeSql(ByVal sql As String) As Collection
Dim tokens As New Collection
Dim i As Long
Dim ch As String
Dim token As String
Dim inSingle As Boolean
Dim inDouble As Boolean
Dim j As Long
i = 1
Do While i <= Len(sql)
ch = Mid$(sql, i, 1)
' ==== ブロックコメント /* ... */ の検出 ====
If Not inSingle And Not inDouble Then
If ch = "/" And i < Len(sql) And Mid$(sql, i + 1, 1) = "*" Then
' 直前までのトークンを確定
If token <> "" Then
tokens.Add token
token = ""
End If
j = i + 2
Do While j <= Len(sql) - 1
If Mid$(sql, j, 2) = "*/" Then
j = j + 2
Exit Do
End If
j = j + 1
Loop
If j > Len(sql) Then j = Len(sql) + 1 ' 万一 */ が無かった場合の保険
' コメント全体を 1 トークンとして追加
tokens.Add Mid$(sql, i, j - i)
i = j
GoTo NextChar
End If
End If
' ==== ここから元々のロジック ====
If inSingle Then
' 単一引用符内（'...'）
token = token & ch
If ch = "'" Then
' '' のエスケープを考慮
If i < Len(sql) And Mid$(sql, i + 1, 1) = "'" Then
token = token & "'"
i = i + 1
Else
tokens.Add token
token = ""
inSingle = False
End If
End If
ElseIf inDouble Then
' 二重引用符内（"..."）
token = token & ch
If ch = """" Then
' "" のエスケープを考慮
If i < Len(sql) And Mid$(sql, i + 1, 1) = """" Then
token = token & """"
i = i + 1
Else
tokens.Add token
token = ""
inDouble = False
End If
End If
Else
' 通常領域
Select Case ch
Case " ", vbTab, vbCr, vbLf
If token <> "" Then
tokens.Add token
token = ""
End If
Case "("
If token <> "" Then
tokens.Add token
token = ""
End If
tokens.Add ch
Case ")"
If token <> "" Then
tokens.Add token
token = ""
End If
tokens.Add ch
Case ","
If token <> "" Then
tokens.Add token
token = ""
End If
tokens.Add ch
Case "'"
If token <> "" Then
tokens.Add token
token = ""
End If
inSingle = True
token = "'"
Case """"
If token <> "" Then
tokens.Add token
token = ""
End If
inDouble = True
token = """"
Case Else
token = token & ch
End Select
End If
NextChar:
i = i + 1
Loop
If token <> "" Then
tokens.Add token
End If
Set TokenizeSql = tokens
End Function
' ==== フォーマッタ本体 ====================================
Private Function BuildFormattedSql(tokens As Collection) As String
Dim sb As String
Dim indentLevel As Long ' () のネストレベル
Dim nextIndentLevel As Long ' キーワード行の次の行のインデント
Dim i As Long
Dim tok As String
Dim lowerTok As String
Dim dispTok As String
indentLevel = 0
nextIndentLevel = 0
sb = ""
i = 1
Do While i <= tokens.Count
tok = tokens(i)
dispTok = tok
lowerTok = LCase$(tok)
' -------------------------------------------------
' 1. 構造トークン（カッコとカンマ）
' -------------------------------------------------
If tok = "(" Then
' "(" を書いて改行 → インデントレベル+1
If EndsWithNewline(sb) Then
sb = sb & IndentString(indentLevel)
ElseIf Len(sb) > 0 Then
If Right$(sb, 1) <> " " Then
sb = sb & " "
End If
End If
sb = sb & "(" & vbCrLf
indentLevel = indentLevel + 1
nextIndentLevel = indentLevel
ElseIf tok = ")" Then
' 閉じカッコの前にインデントレベルを戻す
indentLevel = IIf(indentLevel > 0, indentLevel - 1, 0)
sb = RTrim$(sb) & vbCrLf & IndentString(indentLevel) & ")"
nextIndentLevel = indentLevel
ElseIf tok = "," Then
' カンマの後は改行＋同じインデント
sb = sb & ","
sb = sb & vbCrLf
' nextIndentLevel はそのまま（SELECT句のカラムを揃える）
Else
' -------------------------------------------------
' 2. キーワード結合（GROUP BY / ORDER BY / UNION ALL など）
' -------------------------------------------------
If (lowerTok = "order" Or lowerTok = "group") And i < tokens.Count Then
If LCase$(tokens(i + 1)) = "by" Then
dispTok = tok & " " & tokens(i + 1)
lowerTok = lowerTok & " by"
i = i + 1
End If
ElseIf lowerTok = "union" And i < tokens.Count Then
If LCase$(tokens(i + 1)) = "all" Then
dispTok = tok & " " & tokens(i + 1)
lowerTok = lowerTok & " all"
i = i + 1
End If
End If
' -------------------------------------------------
' 3. キーワード行かどうか
' -------------------------------------------------
If IsSqlKeyword(lowerTok) Then
' 直前の余分な空白カット
sb = RTrim$(sb)
If Len(sb) > 0 Then
sb = sb & vbCrLf
End If
' キーワード自体を表示
sb = sb & IndentString(indentLevel) & dispTok & vbCrLf
' 次の行から一段深くインデント
nextIndentLevel = indentLevel + 1
Else
' -------------------------------------------------
' 4. 通常トークン
' -------------------------------------------------
If EndsWithNewline(sb) Then
' 改行直後ならインデントを入れる
sb = sb & IndentString(nextIndentLevel) & dispTok
ElseIf Len(sb) = 0 Then
sb = dispTok
Else
Dim lastChar As String
lastChar = Right$(sb, 1)
If lastChar = " " Or lastChar = "(" Then
sb = sb & dispTok
Else
sb = sb & " " & dispTok
End If
End If
End If
End If
i = i + 1
Loop
BuildFormattedSql = RTrim$(sb)
End Function
' ==== 補助関数 ============================================
Private Function IndentString(ByVal level As Long) As String
If level < 0 Then level = 0
IndentString = String(level * 4, " ") ' 4スペースインデント
End Function
Private Function EndsWithNewline(ByVal s As String) As Boolean
If Len(s) >= 2 Then
EndsWithNewline = (Right$(s, 2) = vbCrLf)
Else
EndsWithNewline = False
End If
End Function
' SQL キーワード判定
Private Function IsSqlKeyword(ByVal key As String) As Boolean
Select Case key
Case "select", "from", "where", "group", "group by", "order", "order by", _
"having", "join", "inner", "left", "right", "full", "cross", _
"union", "union all", "on", "and", "or", _
"case", "when", "then", "else", "end", _
"update", "insert", "into", "values", "delete", "set"
IsSqlKeyword = True
Case Else
IsSqlKeyword = False
End Select
End Function
