zashii-1434

Stats of My Life(おいしい人生を味わうために、コツコツとチャレンジしたことを書くブログ)

VBA技紹介!ExcelデータからInsert文を作成

[:contents]

❑背景

他部署からもらったExcelファイルには例えば組織情報が記載されており、組織マスタのDBに簡単にInsertして欲しいと依頼を受けました(画面や取込FMTがない状態)。

そこで、Inset文を一気に作成するようなVBAを作成しました。
下記のステップでInset文を作成できます。

①エクセルファイルのシート名にはテーブル名を記載する
②1行目にはカラム名(物理名)を記載する
③2行目以降には1行目の項目に従って実データを記載する
④Inset文生成ボタンを押下する

❑作成方法

Excelにボタンを置いて、イベントを作成する(私の場合「INSERT文を生成_Click()」)
②DataObjectを使うので、ActiveXコンポーネントをシート上に置く
③下記ソースを記載すれば完了です。

Sub INSERT文を生成_Click()
    Dim ws As Worksheet
    Set ws = ActiveSheet

    Dim sql As String
    sql = "INSERT ALL"

    Dim head As String
    head = vbLf & "INTO " & ws.Name & " ("

    Dim Target As Range
    Set Target = ws.UsedRange

    Dim currentCell As Range
    Dim i As Integer

    ' カラム名を列挙
    For i = 1 To Target.Columns.Count
        If (i <> 1) Then
            head = head & ","
        End If
        Set currentCell = ws.Cells(1, i)
        head = head & currentCell.Value
    Next
    head = head & ") values("

    ' 値を列挙
    Dim j As Integer
    Dim strtmp As String
    For j = 2 To Target.Rows.Count

        ' 非表示の行は出力しない
        If Rows(j).Hidden Then GoTo Next_RowLoop

        sql = sql & head

        For i = 1 To Target.Columns.Count
            If (i <> 1) Then
                sql = sql & ","
            End If
            Set currentCell = ws.Cells(j, i)
            If (IsNull(currentCell) Or currentCell.Value = "" Or Trim(currentCell.Value) = "(null)" Or Trim(currentCell.Value) = "null") Then

                ' null
                sql = sql & "null"
            ElseIf IsNumeric(currentCell.Value) Then

                ' 数値
                sql = sql & currentCell.Value
            ElseIf Left(currentCell.Value, 8) = "(SELECT " Then

                ' SQLっぽいものはそのまま
                sql = sql & currentCell.Value
            Else

                ' 文字列はシングルクォーテーションをエスケープする
                strtmp = Replace(currentCell.Value, "'", "''")

                ' セル内の改行を改行コードに変換
                strtmp = Replace(strtmp, vbLf, "' || CHR(13) || CHR(10) ||'")

                sql = sql & "'" & strtmp & "'"
            End If
        Next

        sql = sql & ")"

Next_RowLoop:
    Next

    sql = sql & vbLf & "SELECT * FROM dual;"

    Dim cb As New DataObject
    With cb
        .SetText sql
        .PutInClipboard
    End With
    MsgBox ("クリップボードにコピーしました")
End Sub
        
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

End Sub