vba将Excel当前活动工作表内容一键生成能够插入到oracle数据库的sql语句

likeyouli

内容为原创，ai生成的会有很多小毛病，且很多没有用数组，生成的内容直接粘贴到sql文件里，在sqlplus里执行即可。

Sub 将活动表格内容生成为oracle制表sql语句并直接粘贴()
'需要确保在VBA编辑器中已引用"Microsoft Forms 2.0 Object Library"（通常在引用列表中显示为"FM20.dll"）
    Dim strText As String, colTypes As String, values As String
  '首先生成create表语句,默认首行为标题
arr = Range("a1").CurrentRegion
TableName = InputBox("请输入Oracle表名:", "表名输入", "YOUR_TABLE_NAME")
If Not TableName Like "[a-zA-Z]*" Then MsgBox "表名不是以字母开头,请从新开始": Exit Sub
For i = 1 To UBound(arr, 2)
If  Len(Trim(arr(1, i))) = 0 Then MsgBox "第一行有空单元格": Exit Sub
Next i
For i = 1 To UBound(arr, 2)
    colnames = colnames & arr(1, i)
    If i < UBound(arr, 2) Then colnames = colnames & ","
    colTypes = colTypes & arr(1, i) & " varchar2(4000)," & Chr(13)
Next i
   colTypes = Left(colTypes, InStrRev(colTypes, ",") - 1) & Mid(colTypes, InStrRev(colTypes, ",") + 1)
'以上为生产建表语句   
For j = 2 To UBound(arr)
      values = ""
    For k = 1 To UBound(arr, 2)
        if arr(j,k) = "" then    '不用 If Len(Trim(arr(j, k))) = 0 Then了,因为几十万大数据量时这样判断速度过慢, varchar2类型哪怕是null都不会报错。
            values = values & "null"
'         ElseIf k Mod 6 = 0 Then values = values & "TO_DATE(REGEXP_SUBSTR('" & arr(j, k) & "','^[0-9-]+'),'YYYY-MM-DD')"  '个人认为这里是我写的精华,当遇到特殊列,比如带星期几的日期列,可用正则表达式提取出来,当然前边的生成列的数据类型要改为date类型.这里的数字6为要更改第几列就写几.
         Else
            values = values & "'" & Replace(arr(j, k), "'", "''") & "'"
        End If
         If k < UBound(arr, 2) Then values = values & ","
    Next k
        insertsql = insertsql & "INSERT INTO " & TableName & "(" & colnames & ")  VALUES(" & values & ");" & Chr(13) 'insert into有列名
      '  insertsql = insertsql & " INSERT INTO " & TableName & " VALUES(" & values & ");" & Chr(13)
        If j Mod 300 = 0 Then insertsql = insertsql & "commit;" & Chr(13)  '这里的300可任意改,代表间隔几列commit一次.
    If j = 200000 Then Exit For  '可以设置到二十万行结束
    DoEvents
    Application.StatusBar = Format(j / UBound(arr), "0.0%")  '大数据量可以看看进度
Next j
strText = "set echo on;" & Chr(13) & "CREATE TABLE  " & TableName & Chr(13) & "(" & colTypes & ")" & Chr(13) & _
            "tablespace users storage (next 10M) nologging;" & Chr(13) & "commit;" & Chr(13) & insertsql & "commit;"
    ' 将文本放入剪贴板
    With New DataObject
        .SetText strText
        .PutInClipboard
    End With
    MsgBox "生成的sql语句已复制到粘贴板！"
End Sub

小灰兔

感谢分享

yc2428

谢谢分享！

wn168cn@163.com

感谢分享

guong

谢谢分享

hmaaaa

THX~!感恩分享摟，謝謝大大喔~~!辛苦了！^^

wwss707

谢谢分享！

yzszh64

感谢分享，

wang1126

谢谢楼主分享

classMain

感谢分享