无忧启动论坛

标题: vba将Excel当前活动工作表内容一键生成能够插入到oracle数据库的sql语句 [打印本页]

作者: likeyouli 时间: 2025-4-11 08:16
标题: vba将Excel当前活动工作表内容一键生成能够插入到oracle数据库的sql语句
本帖最后由 likeyouli 于 2025-4-25 18:06 编辑

内容为原创，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(800)," & 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 =6 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

..png (53.1 KB, 下载次数: 45)

..png (8.27 KB, 下载次数: 38)

..png (127.3 KB, 下载次数: 41)

作者: 小灰兔 时间: 2025-4-11 08:43
感谢分享

作者: yc2428 时间: 2025-4-11 09:24
谢谢分享！

作者: wn168cn@163.com 时间: 2025-4-11 09:34
感谢分享

作者: guong 时间: 2025-4-11 12:58
谢谢分享

作者: hmaaaa 时间: 2025-4-11 14:12
THX~!感恩分享摟，謝謝大大喔~~!辛苦了！^^

作者: wwss707 时间: 2025-4-11 14:31

谢谢分享！

作者: yzszh64 时间: 2025-4-11 16:26
感谢分享，

作者: wang1126 时间: 2025-4-11 16:55
谢谢楼主分享

作者: classMain 时间: 2025-4-11 17:42
感谢分享

欢迎光临无忧启动论坛 (http://wuyou.net/)