ExcelVBAでINSERT文を作る

6年前の私が一生懸命つくったExcelマクロが出てきました。
せっかく作ったのに誰にも使ってもらえなくてかわいそうなのでQiitaに載せることで供養。

上の方の定数に従ってシート名等々よしなに設定してボタン置いてボタンクリックでcreateInsertSqlが動くようにすれば使えると思います。（使わせる気ゼロの説明）
B1セルにテーブル物理名、
B2はNULLにしたい項目に埋まってる値（A5Mk2から貼り付けたときの≪NULL≫みたいな用途）、
B3は100件INSERTしたいときに100本のINSERT文が欲しければ1を、100行一本のINSERT文にしたければ2を入れます。
5行目にカラムの物理名、6行目以降にデータを貼り付ければ動くはずです。
使ってるDBに応じてNEW_LINE_STRは書き換えが必要だったような。うろ覚え。

'************************
' INSERT文作成マクロ
'************************
Option Explicit
'データ貼付シートのシート名
Const DATA_SHEET_NAME As String = "データ貼付"
'INSERT文作成結果出力先のシート名
Const RSLT_SHEET_NAME As String = "出力先"
'テーブル物理名を定義するセル
Const TABLE_NAME_CELL As String = "B1"
'NULL文字列を定義するセル
Const NULL_STRING_CELL As String = "B2"
'タイプを定義するセル
Const INSERT_TYPE_CELL As String = "B3"
 
Const EMPTY_STR As String = ""
Const NEW_LINE_STR As String = "' || CHR(10) || '"
Const SQ_STR As String = "'"
Const CM_STR As String = ","
Const START_STR As String = "("
Const END_STR As String = ")"
Const SEMICOLON_STR As String = ";"
Const NULL_STR As String = "NULL"
'タイプ
Enum InsertType
    SingleStatement = 1
    Bulk = 2
End Enum
 
Sub createInsertSql()
 
    Dim stTime As Date
    stTime = Now()
 
    '画面の更新をOFF
    Application.ScreenUpdating = False
    '自動計算をOFF
    Application.Calculation = xlCalculationManual
 
    'データシート
    Dim srcSheet As Worksheet
    Set srcSheet = Worksheets(DATA_SHEET_NAME)
    '結果シート
    Dim resultSheet As Worksheet
    Set resultSheet = Worksheets(RSLT_SHEET_NAME)
    'テーブル名を取得
    Dim tableName As String
    tableName = srcSheet.Range(TABLE_NAME_CELL).Value
    'NULL文字列を取得
    Dim nullString As String
    nullString = srcSheet.Range(NULL_STRING_CELL).Value
    'タイプを取得
    Dim insertTypeString As String
    insertTypeString = srcSheet.Range(INSERT_TYPE_CELL).Value
 
    '結果シートをクリア
    resultSheet.Cells.Clear
 
    'INSERT文の前半
    Dim head As String
    head = "INSERT INTO " & tableName & " (" _
& Join(WorksheetFunction.Index(Range(srcSheet.Cells(5, 1), srcSheet.Cells(5, 1).End(xlToRight)).Value, 1, 0), " ,") & ") values "
    'データシートの最終列の列番号取得
    Dim lastColumnIndex As Long
    lastColumnIndex = srcSheet.Cells(5, 1).End(xlToRight).Column
 
    '件数取得
    Dim rowCount As Long
    rowCount = srcSheet.Cells(5, 1).End(xlDown).Row - 5
 
    'loop用変数
    Dim maxNo As Long
    maxNo = WorksheetFunction.RoundUp(rowCount / 100, 0) - 1
    Dim modNo As Long
    modNo = rowCount Mod 100
    Dim endNo As Long
    Dim loopNo As Long
    Dim dataArr As Variant
    Dim dataRange As Range
    Dim resArr As Variant
    Dim resRange As Range
    Dim currentVal As String
    Dim currentRowIndex As Long
    Dim currentColumnIndex As Long
    Dim valArr() As String
    Dim startRowNo As Long
    Dim endRowNo As Long
 
    'TRUNCATE
    'resultSheet.Cells(1, 1).Value = "TRUNCATE TABLE " & tableName & ";"
    'シーケンス初期化
    'resultSheet.Cells(2, 1).Value = "SELECT SETVAL ('" & tableName & "_seq',1,FALSE);"
    '100件ずつ処理する
    For loopNo = 0 To maxNo
 
        startRowNo = CLng(loopNo * 100 + 6)
        '残り行数が100より少ない場合
        If loopNo = maxNo And modNo > 0 Then
            endRowNo = CLng(loopNo * 100 + modNo + 5)
            endNo = modNo
        Else
            endRowNo = CLng((loopNo + 1) * 100 + 5)
            endNo = 100
        End If
        '対象データを2次元配列として取得
        Set dataRange = Range(srcSheet.Cells(startRowNo, 1), srcSheet.Cells(endRowNo, lastColumnIndex))
        dataArr = dataRange
        'SQL書き出し先のセルを配列として取得
        'B列は不要だが、対象件数が1件の時resArrがEmptyになってしまうためB列も含めて取得
        Set resRange = Range(resultSheet.Cells(startRowNo, 1), resultSheet.Cells(endRowNo, 2))
        resArr = resRange
 
        'INSERT文のvalues以降
        For currentRowIndex = 1 To endNo
 
            ReDim valArr(1 To lastColumnIndex)
 
            For currentColumnIndex = 1 To lastColumnIndex
                currentVal = dataArr(currentRowIndex, currentColumnIndex)
 
                'NULL
                If currentVal = nullString Then
                    valArr(currentColumnIndex) = NULL_STR
                '純粋な数値の場合シングルクォートで囲わない
                ElseIf IsNumeric(currentVal) And currentVal = CStr(Val(currentVal)) Then
                    valArr(currentColumnIndex) = currentVal
                '改行を含む文字列は改行コード置き換え
                ElseIf InStr(currentVal, vbLf) > 0 Then
                    valArr(currentColumnIndex) = SQ_STR & Replace(Replace(currentVal, vbCr, EMPTY_STR), vbLf, NEW_LINE_STR) & SQ_STR
                '文字列はシングルクォートで囲う
                Else
                     valArr(currentColumnIndex) = SQ_STR & currentVal & SQ_STR
                End If
            Next currentColumnIndex
            'タイプによって格納する値を変える
            If insertTypeString = InsertType.SingleStatement Then
                '1行ずつ
                resArr(currentRowIndex, 1) = head & START_STR & Join(valArr, CM_STR) & END_STR & SEMICOLON_STR
            Else
                '一括
                resArr(currentRowIndex, 1) = START_STR & Join(valArr, CM_STR) & END_STR & CM_STR
            End If
        Next currentRowIndex
 
        resRange = resArr
 
    Next loopNo
    '一括の場合の処理
    If insertTypeString = InsertType.Bulk Then
        'INSERT文の前半を1行目にセット
        resultSheet.Cells(5, 1) = head
        '最終行の末尾をセミコロンに置き換え
        Dim lastRowStr As String
        lastRowStr = resultSheet.Cells(5, 1).End(xlDown).Value
        Mid(lastRowStr, Len(lastRowStr)) = SEMICOLON_STR
        resultSheet.Cells(5, 1).End(xlDown).Value = lastRowStr
    End If
 
    '生成結果シートを選択
    resultSheet.Activate
    '画面の更新をON
    Application.ScreenUpdating = True
    '自動計算をON
    Application.Calculation = xlCalculationAutomatic
    MsgBox "生成完了(" & DateDiff("s", stTime, Now) & "秒)"
 
End Sub

単なる閉じ括弧とかまで定数化してるのも、ループが無駄に複雑になっているのも、
暇すぎて「50万件のInsert文作らせても固まらないように」とかを考えてた時の名残です。
その後割とすぐ暇でなくなったのでたぶん50万件のInsert文作成には耐えられないと思います。
たまに直そうとしているんですが変数の命名が適当すぎた上にコメントつけなかったので挫折しています。
自ら恥をさらしていくスタイル・・・(´･ω･`)

シングルクォートで括るか否かの判定が気持ち悪いんですが、使いやすさと私のVBAスキルの限界でクソ判定のままになっています。もっとスマートに書きたい

6年前に書いた時どこかの誰かの技術ブログを参考にしたはずなのですが見失ってしまいました。
こんな記事でも誰かの役に立つことがあれば幸いです。

どうでもいいですがMarkdown的に「VBA」だと文字色変わらなかったので「VB」にしています。
「VBが見たかったんじゃ！」と思われた方がいたらごめんなさい。