SSMSで生成したINSERT文の項目名と値の対応をExcelで確認できるようにするVBA

ChatGPTに作ってもらいました。個人的な備忘録なので使用の際は各自の判断でお願いします。

使い方

アクティブシートのA列に複数のINSERT文を貼り付ける
マクロを実行
SQL_Results シートに解析結果が出力される

注意点

INSERT先は同一のテーブルしか対応できてません

コード

Sub ParseSQLInsert_Multiple()
    Dim wsSource As Worksheet, wsTarget As Worksheet
    Dim sql As String
    Dim lastRow As Long, rowIndex As Long, colStart As Integer
    Dim fieldsPart As String, valuesPart As String
    Dim fieldsArray As Variant, valuesArray As Variant
    Dim i As Integer
    Dim regex As Object
    Dim matches As Object
    Dim outputRow As Long, firstSQL As Boolean

    ' ソースシートとターゲットシートを取得（なければ作成）
    Set wsSource = ActiveSheet
    On Error Resume Next
    Set wsTarget = ThisWorkbook.Sheets("SQL_Results")
    If wsTarget Is Nothing Then
        Set wsTarget = ThisWorkbook.Sheets.Add
        wsTarget.Name = "SQL_Results"
    End If
    On Error GoTo 0

    ' A列の最終行を取得
    lastRow = wsSource.Cells(wsSource.Rows.Count, 1).End(xlUp).Row
    outputRow = 2  ' 出力先の開始行（1行目はヘッダー）

    ' 正規表現オブジェクトの作成
    Set regex = CreateObject("VBScript.RegExp")
    regex.Global = True
    regex.IgnoreCase = True
    regex.Pattern = "CAST\((.*?) AS .*?\)|NULL|N?'(.*?)'|(\d+(\.\d+)?)"

    ' 1つ目のSQLの処理でヘッダーを記録
    firstSQL = True

    ' A列の各行をループ
    For rowIndex = 1 To lastRow
        sql = wsSource.Cells(rowIndex, 1).Value
        If sql = "" Then GoTo NextSQL ' 空白ならスキップ

        ' INSERT文のカラム部分を抽出
        Dim startPos As Integer, endPos As Integer
        startPos = InStr(sql, "(") + 1
        endPos = InStr(sql, ") VALUES")
        If startPos = 1 Or endPos = 0 Then GoTo NextSQL ' エラーならスキップ
        fieldsPart = Mid(sql, startPos, endPos - startPos)

        ' VALUES部分を抽出
        startPos = InStr(sql, "VALUES (") + 8
        endPos = InStrRev(sql, ")")
        valuesPart = Mid(sql, startPos, endPos - startPos)

        ' カラム名を配列に変換
        fieldsArray = Split(fieldsPart, ", ")

        ' 正規表現で値の配列を取得
        Set matches = regex.Execute(valuesPart)
        ReDim valuesArray(UBound(fieldsArray))

        ' マッチした値を配列に格納
        For i = 0 To matches.Count - 1
            If matches(i).SubMatches(0) <> "" Then
                valuesArray(i) = matches(i).SubMatches(0) ' CAST(...) の場合
            ElseIf matches(i).SubMatches(1) <> "" Then
                valuesArray(i) = matches(i).SubMatches(1) ' N'...' の場合
            ElseIf matches(i).SubMatches(2) <> "" Then
                valuesArray(i) = matches(i).SubMatches(2) ' 数値
            Else
                valuesArray(i) = "NULL" ' NULL の場合
            End If
        Next i

        ' ヘッダー行を出力（最初のSQLのみ）
        If firstSQL Then
            wsTarget.Cells(1, 2).Resize(1, UBound(fieldsArray) + 1).Value = fieldsArray
            firstSQL = False
        End If

        ' 解析結果を出力
        wsTarget.Cells(outputRow, 1).Value = rowIndex ' 元の行番号
        wsTarget.Cells(outputRow, 2).Resize(1, UBound(valuesArray) + 1).Value = valuesArray
        outputRow = outputRow + 1

NextSQL:
    Next rowIndex

    MsgBox "すべてのSQLを解析しました！", vbInformation
End Sub