excel的宏与VBA实践——建表语句
一、建表语句
不带分区版本:V1.0:
Sub createTableDDL() '自动创建建表语句 '定义换行和TAB Ln = Chr(13) + Chr(10) TB = Chr(9) '定义脚本目录 Dim dir AS String dir = "C:\CREATE_TABLE_DDL" Set FSOE = CreateObject("Scripting.FileSystemObject") If FSOE.folderexists(dir) = False Then MkDir dir End If '调用脚本定义 Set SqlFileDDL = FSOE.CreateTextFile("C:\CREATE_TABLE_DDL\create_table_ddl.sql", True) '获得表名 tableName = Trim(Cells(1, 2).Value) '获得表注释 tableComment = Trim(Cells(1, 4).Value) '获得创建者 createBy = Trim(Cells(1, 6).Value) Dim dt As Date dt = Format(Date, "yyyy-mm-dd") '获得当前日期 createDate = dt '获得A列已使用的行数 count_row_k = [A65536].End(xlUp).Row '定义SQL SQL = "--创建者:" & createBy & Ln SQL = SQL & "--创建时间:" & createDate & Ln SQL = SQL & "DROP TABLE IF EXISTS " & tableName & " ;" & Ln SQL = SQL & "CREATE TABLE " & tableName & "(" '写入文件 SqlFileDDL.WriteLine (SQL) For i = 3 To count_row_k If i = count_row_k Then col_name = TB & LCase(Cells(i, 2)) & " " & UCase(Cells(i, 4)) & " COMMENT '" & Trim(Cells(i, 3)) & "'" & Ln & ")" SqlFileDDL.WriteLine(col_name) Exit For End If col_name = TB & LCase(Cells(i, 2)) & " " & UCase(Cells(i, 4)) & " COMMENT '" & Trim(Cells(i, 3)) & "'," SqlFileDDL.WriteLine(col_name) Next SqlFileDDL.WriteLine("COMMENT '" & tableComment & "'") MsgBox("生成成功!生成路径为:" & dir) End Sub
带分区与生命周期版本V2.0:
Sub create_ddl()
'自动创建建表语句
'定义换行和TAB
Ln = Chr(13) + Chr(10)
TB = Chr(9)
'定义脚本目录
Dim dir As String
dir = "C:\CREATE_TABLE_DDL"
Set FSOE = CreateObject("Scripting.FileSystemObject")
If FSOE.folderexists(dir) = False Then
MkDir dir
End If
'调用脚本定义
Set SqlFileDDL = FSOE.CreateTextFile("C:\CREATE_TABLE_DDL\create_table_ddl.sql", True)
'获得表名
TableName = Trim(Cells(1, 2).Value)
'获得表注释
tableComment = Trim(Cells(1, 4).Value)
'获得生命周期
lifecycle = Trim(Cells(1, 6).Value)
'获得创建者
createBy = Trim(Cells(1, 8).Value)
Dim dt As Date
dt = Format(Date, "yyyy-mm-dd")
'获得当前日期
createDate = dt
'获得A列已使用的行数
count_row_k = [A65536].End(xlUp).Row
'获得E列已使用的行数
part_row_k = [E65536].End(xlUp).Row
'定义SQL
Sql = "--创建者:" & createBy & Ln
Sql = Sql & "--创建时间:" & createDate & Ln
Sql = Sql & "DROP TABLE IF EXISTS " & TableName & " ;" & Ln
Sql = Sql & "CREATE TABLE " & TableName & "("
'写入文件
SqlFileDDL.WriteLine (Sql)
For i = 3 To count_row_k
If i = count_row_k Then
col_name = TB & LCase(Cells(i, 2)) & " " & UCase(Cells(i, 4)) & " COMMENT '" & Trim(Cells(i, 3)) & "'" & Ln & ")"
SqlFileDDL.WriteLine (col_name)
Exit For
End If
col_name = TB & LCase(Cells(i, 2)) & " " & UCase(Cells(i, 4)) & " COMMENT '" & Trim(Cells(i, 3)) & "',"
SqlFileDDL.WriteLine (col_name)
Next
SqlFileDDL.WriteLine ("COMMENT '" & tableComment & "'")
'加上分区列
If part_row_k > 2 Then
part_col_name = "PARTITIONED BY ("
SqlFileDDL.WriteLine (part_col_name)
For j = 3 To part_row_k
If j = part_row_k Then
part_col_name = TB & LCase(Cells(j, 5)) & " " & UCase(Cells(j, 6)) & " COMMENT '" & Trim(Cells(j, 7)) & "'"
SqlFileDDL.WriteLine (part_col_name)
Exit For
End If
part_col_name = TB & LCase(Cells(j, 5)) & " " & UCase(Cells(j, 6)) & " COMMENT '" & Trim(Cells(j, 7)) & "'" & ","
SqlFileDDL.WriteLine (part_col_name)
Next
End If
'加上生命周期
SqlFileDDL.WriteLine ("LIFECYCLE " & lifecycle & ";")
MsgBox ("生成成功!生成路径为:" & dir)
End Sub
模板:
更新版本2.1:
Sub createTableDDL()
'定义换行和TAB
Ln = Chr(13) + Chr(10)
TB = Chr(9)
'定义脚本目录
Dim dir AS String
dir = "C:\CREATE_TABLE_DDL"
Set FSOE = CreateObject("Scripting.FileSystemObject")
If FSOE.folderexists(dir) = False Then MkDir dir
'调用脚本定义
Set SqlFileDDL = FSOE.CreateTextFile("C:\CREATE_TABLE_DDL\create_table_ddl.sql", True)
'获得表名
tableName = Trim(Cells(1, 2).Value)
'获得表注释
tableComment = Trim(Cells(1, 4).Value)
'获得生命周期
lifecycle = Trim(Cells(1, 6).Value)
'获得创建者
createBy = Trim(Cells(1, 8).Value)
Dim dt As Date
dt = Format(Date, "yyyy-mm-dd")
'获得当前日期
createDate = dt
'获得A列已使用的行数
count_row_k = [A65536].End(xlUp).Row
'获得E列已使用的行数
part_row_k = [E65536].End(xlUp).Row
'定义SQL
SQL = "--创建者:" & createBy & Ln & _
"--创建时间:" & createDate & Ln & _
"DROP TABLE IF EXISTS " & tableName & " ;" & Ln & _
"CREATE TABLE " & tableName & "("
'写入文件
SqlFileDDL.WriteLine (SQL)
For i = 3 To count_row_k - 1
col_name = TB & LCase(Cells(i, 2)) & " " & UCase(Cells(i, 4)) & " COMMENT '" & Trim(Cells(i, 3)) & "',"
SqlFileDDL.WriteLine(col_name)
Next
'最后一列
i = count_row_k
col_name = TB & LCase(Cells(i, 2)) & " " & UCase(Cells(i, 4)) & " COMMENT '" & Trim(Cells(i, 3)) & "'" & Ln & ")"
SqlFileDDL.WriteLine(col_name)
SqlFileDDL.WriteLine("COMMENT '" & tableComment & "'")
'加上分区列
If part_row_k > 2 Then
part_col_name = "PARTITIONED BY ("
SqlFileDDL.WriteLine(part_col_name)
For j = 3 To part_row_k - 1
part_col_name = TB & LCase(Cells(j, 5)) & " " & UCase(Cells(j, 6)) & " COMMENT '" & Trim(Cells(j,7)) & "'" & ","
SqlFileDDL.WriteLine(part_col_name)
Next
j = part_row_k
part_col_name = TB & LCase(Cells(j, 5)) & " " & UCase(Cells(j, 6)) & " COMMENT '" & Trim(Cells(j,7)) & "'"
SqlFileDDL.WriteLine(part_col_name)
End If
'加上生命周期
SqlFileDDL.WriteLine("LIFECYCLE " & lifecycle & ";")
MsgBox("生成成功!生成路径为:" & dir)
End Sub
//模板在微云文件中。
二、反向解析
通过DDL,反向解析出字段填充到excel中
反向解析1.0:
REM "获取数组长度"
Public Function ArrayLength(ByVal ary) As Integer
ArrayLength = UBound(ary) - LBound(ary) + 1
End Function
Sub resverse_parse()
'获得表名
tableDDL = Trim(Cells(1, 2).Value)
'截取语句字段部分(以括号分隔)
index_quote_left_1 = InStr(1,tableDDL,"(")
index_quote_right_1 = InStr(1,tableDDL,")")
index_quote_left_2 = InStr(index_quote_right_1 + 1,tableDDL,"(")
index_quote_right_2 = InStr(index_quote_right_1 + 1,tableDDL,")")
table_comment_content = Mid(tableDDL,index_quote_right_1 + 1,index_quote_left_2)
table_comment_arr = Split(table_comment_content, "'")
table_comment = table_comment_arr(1)
Cells(3, 4).Value = table_comment
table_name = Mid(tableDDL,14,index_quote_left_1 - 14)
Cells(3, 2).Value = table_name
table_content = Mid(tableDDL,index_quote_left_1,index_quote_right_1 - index_quote_left_1 - 1)
content_arr = Split(table_content,",")
content_len = ArrayLength(content_arr)
For i = 0 to content_len - 1 step 1
col_arr = Split(content_arr(i)," ")
j = i + 5
col_name = col_arr(1)
col_comment = Replace(col_arr(4),"'","")
MsgBox col_comment
Cells(j, 1).Value = col_name
Cells(j, 2).Value = col_comment
Next i
End Sub
清除重置1.1(1.0为直接清除指定区域版,已废弃):
Sub clear()
'采用先清除后填充的策略
Range("A1:D256").ClearContents
'填充
Cells(1, 1).Value = "建表DDL"
Cells(3, 1).Value = "表名"
Cells(3, 3).Value = "表注释"
Cells(4, 1).Value = "列名"
Cells(4, 2).Value = "列注释"
End Sub
模板文件在百度云中,图示如下: