INSERT / DELETE 文の生成用 Excel VBA

データベース用の値を扱うとき、表と INSERT 文と DELETE 文が同時に更新される仕組みを用意しておくと管理しやすい。

なので仕事にしろ趣味にしろデータベース環境が変わるたびにそれ用の Excel を準備するのだけど、仕事の場合は現場が変わると持ち越せなくて面倒くさい。

特に Excel VBA なんて書かない時期には本当に書かないので忘れてしまう。

ということでメモ。

仕様

INSERT 用と DELETE 用、ふたつのユーザ定義関数をベースに動作する。

createSqlToInsert()

INSERT 文を生成する。

• 引数
  • 引数 1 には表の物理名があるセルを縱橫固定で設定。
  • 引数 2 には列の物理名がある行を縱固定で設定。
  • 引数 3 には列の型がある行を縱固定で設定。
  • 引数 4 には列の値を設定。単一行。
• 補足
  • この関数と引数 4 の内容は同じ行に書く想定。

createSqlToDelete()

DELETE 文を生成する。

• 引数
  • 引数 1 ～ 3 は createSqlToInsert() と同じ。
  • 引数 4 には列の値を設定。複数行。削除対象を引き当てる条件に用いる値を選択する。
• 補足
  • この関数は引数 4 は違う行に書く想定。
    • createSqlToInsert() は縦に列挙する想定だが、それらの上に書いて一緒にコピペすることで削除と再登録を一度に行う感じ。
    • ただの自分のこだわり。コードの仕様上、同じ行に書いても動作はするはず。

定数

共通設定。

• UNQUOTED_COLUMN_TYPES にはクォートしない列の型を列挙する。
  • Excel VBA では定数に配列を用いることができないため、文字列型で定義している。
  • 今回のコードでは PostgreSQL を雑に想定。

Excel VBA コード

Module

Option Explicit

'* クォートを行わない型名. 各値は必ず * で囲む.
Const UNQUOTED_COLUMN_TYPES As String = "*numeric*decimal*integer*"



' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
' INSERT 文の作成

'* INSERT 文を作成する.
'*
'* @param tableNameCell      テーブル名が格納されているセル.
'* @param columnNameRow      カラムの物理名が格納されている行.
'* @param columnTypeRow      カラムの型名が格納されている行.
'* @param columnValueCells   カラムの値が格納されているセル範囲. 各セルは、同じ列番号の物理名と型を参照する. 単行想定.
'* @return SQL.
Public Function createSqlToInsert( _
        tableNameCell As Range, _
        columnNameRow As Range, _
        columnTypeRow As Range, _
        valueCells As Range _
) As String
    Dim Sql As String

    Sql = "INSERT INTO " + tableNameCell.value
    Sql = Sql + createColumnNamesOfSqlToInsert(columnNameRow.Row, valueCells)
    Sql = Sql + createColumnValuesOfSqlToInsert(columnTypeRow.Row, valueCells)

    createSqlToInsert = Sql + ";"
End Function

'* INSERT 文のカラム名列挙部分を作成する.
'*
'* @param nameRowNumber   カラムの物理名が格納されている行番号.
'* @param valueCells      カラムの値が格納されているセル範囲. 各セルは、同じ列番号の物理名を参照する.
'* @return INSERT 文のカラム名列挙部分の SQL.
Private Function createColumnNamesOfSqlToInsert( _
        nameRowNumber As Integer, _
        valueCells As Range _
) As String
    Dim Sql As String
    Dim x As Integer
    Dim columnNumber As Integer

    For x = 1 To valueCells.Columns.Count
        If x > 1 Then
            Sql = Sql + ", "
        End If

        columnNumber = valueCells.Column + x - 1
        Sql = Sql + Cells(nameRowNumber, columnNumber).value
    Next x

    createColumnNamesOfSqlToInsert = " (" + Sql + ")"
End Function

'* INSERT 文の値列挙部分を作成する.
'*
'* @param typeRowNumber  カラムの型名が格納されている行番号.
'* @param valueCells     カラムの値が格納されているセル範囲. 各セルは、同じ列のカラムの物理名を参照する.
'* @return INSERT 文の値列挙部分の SQL.
Private Function createColumnValuesOfSqlToInsert( _
        typeRowNumber As Integer, _
        valueCells As Range _
) As String
    Dim Sql As String
    Dim x As Integer
    Dim columnNumber As Integer

    For x = 1 To valueCells.Columns.Count
        If x > 1 Then
            Sql = Sql + ", "
        End If

        columnNumber = valueCells.Column + x - 1
        Sql = Sql + optimizeValueOfSql( _
                Cells(typeRowNumber, columnNumber).value, _
                valueCells(x))
    Next x

    createColumnValuesOfSqlToInsert = " VALUES(" + Sql + ")"
End Function



' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
' DELETE 文の作成

'* DELETE 文を作成する.
'*
'* @param tableNameCell      テーブル名が格納されているセル.
'* @param columnNameRow      カラムの物理名が格納されている行.
'* @param columnTypeRow      カラムの型名が格納されている行.
'* @param columnValueCells   カラムの値が格納されているセル範囲. 各セルは、同じ列番号の物理名と型を参照する. 複数行想定.
'* @return SQL.
Public Function createSqlToDelete( _
        tableNameCell As Range, _
        columnNameRow As Range, _
        columnTypeRow As Range, _
        valueCells As Range _
) As String
    Dim Sql As String

    Sql = "DELETE FROM " + tableNameCell.value
    Sql = Sql + createWhereClauseOfSqlToDelete(columnNameRow.Row, columnTypeRow.Row, valueCells)

    createSqlToDelete = Sql + ";"
End Function

'* DELETE 文の WHERE 句部分を作成する.
'*
'* @param nameRowNumber  カラムの物理名が格納されている行番号.
'* @param typeRowNumber  カラムの型名が格納されている行番号.
'* @param valueCells     カラムの値が格納されているセル範囲. 各セルは、同じ列のカラムの物理名を参照する.
'* @return DELETE 文の WHERE 句部分の SQL.
Private Function createWhereClauseOfSqlToDelete( _
        nameRowNumber As Integer, _
        typeRowNumber As Integer, _
        valueCells As Range _
) As String
    Dim Sql As String
    Dim x As Integer
    Dim y As Integer
    Dim columnNumber As Integer

    For y = 1 To valueCells.Rows.Count
        If x > 1 Then
            Sql = Sql + " OR "
        End If

        Sql = Sql + "("
        For x = 1 To valueCells.Columns.Count
            If x > 1 Then
                Sql = Sql + " AND "
            End If

            columnNumber = valueCells.Column + x - 1
            Sql = Sql + Cells(nameRowNumber, columnNumber).value + " = "
            Sql = Sql + optimizeValueOfSql( _
                    Cells(typeRowNumber, columnNumber).value, _
                    valueCells(y, x))
        Next x
        Sql = Sql + ")"
    Next y

    createWhereClauseOfSqlToDelete = " WHERE " + Sql
End Function




' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
' 共通で使用する関数

'* 値を型によって最適化する.
'*
'* @param columnType   カラムの型名.
'* @param columnValue  カラムの値.
'* @return 最適化された値.
Private Function optimizeValueOfSql( _
        columnType As String, _
        columnValue As String _
) As String
    Dim result As String

    ' 値が規定の文字から始まる場合、以降の値を無加工
    If Mid(columnValue, 1, 3) = "###" Then
        result = Mid(columnValue, 4)
    ' null のときは無加工
    ElseIf columnValue = "null" Then
        result = columnValue
    ' クォート対象の型か否か
    ElseIf InStr(UNQUOTED_COLUMN_TYPES, "*" + columnType + "*") > 0 Then
        ' クォート対象で値が空文字のとき null
        If columnValue = "" Then
            result = "null"
        ' クォート対象で値が存在するとき無加工
        Else
            result = columnValue
        End If
    ' クォート対象のとき値をクォート
    Else
        result = "'" + columnValue + "'"
    End If

    optimizeValueOfSql = result
End Function