[: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