INSRET 文を自動生成するVBA

途中なんだけど、なんだか面倒になっちゃってもう公開しちゃえ。
公開したら、直さないわけにはいかんし。

Option Explicit

Sub createSQL(ByVal sh As Worksheet, ByVal flg As String)
    Const SQL_INSERT As String = "INSERT INTO {1} ({2}) VALUES ({3});"
    Const SQL_UPDATE As String = "UPDATE {1} SET {2} WHERE {3};"
    Dim tbl As String 'テーブル名
    Dim columns As Range  'カラム
    Dim colType As Range '型
    Dim colWhere As Range 'Where句
    Dim value As String '値
    Dim dataTopRow As Long, dataEndRow As Long 'データ先頭行, データ末尾行
    Dim endRigthCol As Long
    Dim sqlCol As String, sqlVal As String
    Dim data As Range
    Dim i As Long, j As Long
    Dim buf As String, bufUpdSet As String, bufUpdWhere As String, bufWhere As String
    Dim sqlInsert As String
    Dim sqlUpdate As String

    sqlInsert = SQL_INSERT
    sqlUpdate = SQL_UPDATE
    
    'テーブル名をセット
    sqlInsert = Replace(sqlInsert, "{1}", sh.Range("D4").value)
    sqlUpdate = Replace(sqlUpdate, "{1}", sh.Range("D4").value)
    
    '最終列
    endRigthCol = sh.Range("D5").End(xlToRight).Column
    'カラム名
    Set columns = sh.Range("D5:" & sh.Range("D5").End(xlToRight).Address)
    '型
    Set colType = sh.Range("D5:" & sh.Range("D5").End(xlToRight).Address).Offset(1, 0)
    'Where句
    Set colWhere = sh.Range("D5:" & sh.Range("D5").End(xlToRight).Address).Offset(2, 0)
    
    dataTopRow = sh.Range("D8").Row 'Value行先頭
    dataEndRow = sh.Cells(Rows.Count, 4).End(xlUp).Row 'value行末尾
    
    'INSERT文用にカラム名を取得
    For i = 1 To columns.Count
        If (i = 1) Then
            sqlCol = sqlCol & columns(1, i)
        Else
            sqlCol = sqlCol & ", " & columns(1, i)
        End If
    Next i
    
    For i = dataTopRow To dataEndRow
        sqlVal = ""
        bufUpdSet = ""
        bufWhere = ""
        Set data = sh.Range(Cells(i, 4), Cells(i, endRigthCol))
        For j = 1 To data.Count
            buf = data(1, j)
            If (colType(1, j) > "number") Then
                buf = "'" & data(1, j) & "'"
            End If
            If (j = 1) Then
                sqlVal = sqlVal & buf
            Else
                sqlVal = sqlVal & ", " & buf
            End If
            
            If (colWhere(1, j) = "○") Then
                If bufWhere = "" Then
                    bufWhere = columns(1, j) & " = " & buf
                Else
                    bufWhere = bufWhere & " AND " & columns(1, j) & " = " & buf
                End If
            End If
            If bufUpdSet = "" Then
                bufUpdSet = columns(1, j) & " = " & buf
            Else
                bufUpdSet = bufUpdSet & ", " & columns(1, j) & " = " & buf
            End If
        Next j
        sh.Cells(i, 2) = Replace(Replace(sqlInsert, "{2}", sqlCol), "{3}", sqlVal)
        sh.Cells(i, 3) = Replace(Replace(sqlUpdate, "{2}", bufUpdSet), "{3}", bufWhere)
    Next i
End Sub