Excelから、データベースのマスタ更新用のSQLを生成する。（SQL Server）

Microsoft Office 技術メモ

ユーザーマスタとかを変更する作業を楽にするためのマクロを作ったのでメモ。


●目的

・SQLを書くのが面倒なので、省力化したい。
・修正前・後の作業履歴を残したい。
・同じような修正が複数あるので、Excel上で打ち込めると楽（打ち間違いも減る）。
・問題あったときとかに修正前に戻しやすくしたい。


●操作手順

１．［設定シート］シートに、更新する「テーブル名」と「検索キーになるフィールド名」を入れる。


２．変更前のマスタをExcelにコピペする。
　　（想定；SELECT文 実行→抽出結果を全選択→コピー→Excelに張り付け）
　　（※Excelの表示形式を「文字列」にしておくこと！！）

３．変更前マスタの行へ、セルの書式設定から「取り消し線」を適用する。
　　（取り消し線を適用したレコードはDELETEする）

４．変更後のマスタをすぐ下に記載する。
　　（想定：２．を行コピーしてすぐ下に張り付けて、更新するところを書き換える）

５．↓のマクロを実行すると、SQLを書いたテキストファイルが作られる。
　　（※あらかじめServerに接続させておくこと）

※変更前に戻す場合は、変更前後の行を入れ替えて、取り消し線の書式を設定する。

Option Explicit

' ------------------------------
' 修正差分からSQL文作成のマクロ
' ------------------------------
Sub subMakeSQL()

    Dim wParameter      As Worksheet    ' テーブル名やキーフィールドを記載したシート
    Dim wData           As Worksheet    ' SQLの元データシート
    Dim rngData         As Range        ' SQLの元データのキーフィールド列
    Dim strTableName    As String       ' テーブル名
    Dim strFieldName()  As String       ' キーフィールド名
    Dim strSQL          As String       ' SQL文字列保存用
    Dim strOutput       As String       ' 出力するテキストファイル名
    Dim iArray          As Long         ' カウンタ用（キーフィールド）
    Dim iRow            As Long         ' カウンタ用（行）
    Dim iColumn         As Long         ' カウンタ用（列）

    Set wParameter = ThisWorkbook.Worksheets("設定シート")
    Set wData = ThisWorkbook.Worksheets("更新内容")

    strTableName = wParameter.Range("A2").Value
    strFieldName = Split(wParameter.Range("B2").Value, ",")
    strOutput = "SQL_" & strTableName & "_" & Format(Now(), "yyyymmdd") & Format(Now(), "hhmmss")

    Application.ScreenUpdating = False

    ' ------------------------------
    ' ●更新内容シートの内容を読み取る
    For iRow = 2 To wData.Range("A1").End(xlDown).Row Step 1

        ' ------------------------------
        ' ●削除／追加の判断
        ' ------------------------------
        ' ▲取消し線あり→DELETE
        If wData.Range("A" & iRow).Font.Strikethrough = True Then
            ' 変に文字結合しないよう先頭に半角スペースを追加
            strSQL = ""
            strSQL = strSQL & " DELETE FROM"
            strSQL = strSQL & " " & strTableName
            strSQL = strSQL & " WHERE"

            ' 抽出条件を追加（「検索条件フィールド」のデータを引っ張ってくる）
            For iArray = 0 To UBound(strFieldName) Step 1
                ' データが無しエラースキップ
                On Error Resume Next
                Set rngData = wData.Range("1:1").Find(What:=strFieldName(iArray), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, MatchByte:=True, MatchCase:=True)
                On Error GoTo 0
                If Not rngData Is Nothing Then
                    ' 値に"'"があれば"''"へ変換
                    strSQL = strSQL & " AND " & strFieldName(iArray) & "= '" & Replace(rngData.Offset(iRow - 1, 0).Value, "'", "''") & "' "
                End If
            Next iArray

            ' 抽出条件の先頭にANDが付いているため変換する。
            strSQL = Replace(strSQL, " DELETE FROM " & strTableName & " WHERE AND", " DELETE FROM " & strTableName & " WHERE")

            ' 抽出条件が何もない場合、WHERE句を削除
            If Right(strSQL, 5) = "WHERE" Then
                strSQL = Left(strSQL, Len(strSQL) - 5)
            End If
            
        ' ------------------------------
        ' ▲取消し線なし→INSERT
        Else
            ' 変に文字結合しないよう先頭に半角スペースを追加
            strSQL = ""
            strSQL = strSQL & " INSERT INTO"
            strSQL = strSQL & " " & strTableName
            strSQL = strSQL & " VALUES("
            For iColumn = 1 To wData.Range("A1").End(xlToRight).Column Step 1
                ' インサートする文字がNULLの場合は''で囲わない
                If wData.Cells(iRow, iColumn).Value = "NULL" Then
                    ' NULLはNULLとする
                    strSQL = strSQL & wData.Cells(iRow, iColumn).Value & ","
                Else
                    ' 値に"'"があれば"''"へ変換
                    strSQL = strSQL & "'" & Replace(wData.Cells(iRow, iColumn).Value, "'", "''") & "',"
                End If
            Next iColumn

            ' 最後のデータに付いた","を削除
            strSQL = Left(strSQL, Len(strSQL) - 1)
            strSQL = strSQL & ")"
        End If
        ' ------------------------------
        ' ●テキストファイルへ出力（同じフォルダ内へ）
        Open ActiveWorkbook.Path & "\" & strOutput & ".txt" For Append As #1
            Print #1, strSQL
        Close #1
        
    Next iRow

    Application.ScreenUpdating = True

    MsgBox ("「" & strOutput & ".txt」を作りました。")

End Sub