1. 表格设计

• 直接看图，3个页签
  
• 《建表语句》页签，把设计的表名统计到此页签，在【是否建表】控制是否创建该表的建表语句，1是 其他否。

2. 效果展示

• 点击生成对应的sql文件（建表语句）
  
• 去路径下查看对应的sql文件，打开即可查看相应的建表语句
  
  

3. VB代码

• 代码截图
  
  
• 代码源码

'基础层CREATE
Sub MySQL建表sql()
    
    Dim avFilePath As String '文件路径
    Dim lvIntFileNum As Integer '空文件号
    Dim lvContents As String
    avFilePath = "F:\mysql_createtable_" & Format(Date, "yyyymmdd") & "_v1.0" & ".sql" '文件路径
    TargetSheetName = "建表语句"
    
     '生成建表hql
    Dim sql As String
    Dim cc As String
    Dim tableName As String             '表名
    Dim tableComm As String             '表注释
    Dim firstColumn As Integer          '是否首个字段
    Dim clusterColumn As String         '分桶字段
    Dim clusterNum  As String           '分桶数量
      Dim version_type  As String         '版本标志
      Dim PRIMARY As String               '主键'
       Dim PP As String               '主键'
      
            
        Set mysheet = Workbooks(1).Sheets(TargetSheetName)  '指定表名所在的sheet，根据实际修改
        For table_cnt = 2 To mysheet.UsedRange.Rows.Count '从第2行开始遍历所有的列
      
            Set mysheet = Workbooks(1).Sheets(TargetSheetName) '指定表名所在的sheet，根据实际修改
            
            tableName = mysheet.Range("B" & table_cnt).Value '英文表名，根据实际修改
            tableComm = mysheet.Range("A" & table_cnt).Value '中文表名，根据实际修改
                  version_type = mysheet.Range("C" & table_cnt).Value '版本标志
                  
                  
            
            If tableName <> "" And version_type = "1" Then
            
            clusterColumn = ""
            clusterNum = ""
            cc = ""
            PRIMARY = ""
            PP = ""
            'sql = sql & "DROP TABLE IF EXISTS XIBREW." & tableName & ";" & vbLf
            
            sql = sql & "CREATE TABLE " & tableName & "  ( " & vbLf
              
            Set mysheet = Workbooks(1).Sheets("MySQL数据库表设计") '指定字段名所在的sheet，根据实际修改
            firstColumn = 1
            For i = 2 To mysheet.UsedRange.Rows.Count '从第2行开始遍历所有的列
                Dim nameStr As String
                Dim typeStr As String
              
                If mysheet.Range("C" & i).Value = tableName Then
                    nameStr = mysheet.Range("D" & i).Value '字段名，根据实际修改
                    commStr = mysheet.Range("E" & i).Value '中文注释，根据实际修改
                    typeStr = mysheet.Range("F" & i).Value '数据类型，根据实际修改
                    

                   If mysheet.Range("G" & i).Value = "是" Then          '是否主键
                        PRIMARY = mysheet.Range("D" & i).Value
                    End If
            
                    If firstColumn = 1 Then
                        sql = sql & "    " & nameStr & " " & typeStr & " DEFAULT NULL COMMENT '" & commStr & "'"
                    Else
                        sql = sql & "    ," & nameStr & " " & typeStr & " DEFAULT NULL COMMENT '" & commStr & "'"
                    End If
                   If PRIMARY <> "" Then
                        PP = clusterNum & "ALTER TABLE  " & tableName & " ADD PRIMARY KEY(" & PRIMARY & ");"
                    Else
                        PP = PRIMARY
                    End If
                    sql = sql & vbLf
                    cc = cc & "COMMENT ON COLUMN " & tableName & "." & nameStr & " IS '" & commStr & "';" & vbLf
                    firstColumn = firstColumn + 1
                End If
            
            Next i
            
            sql = sql & ")" & vbLf & "ENGINE = InnoDB DEFAULT CHARSET=utf8 COMMENT= '" & tableComm & "';" & vbLf & PP & vbLf & vbLf
            
            End If
        
        Next table_cnt
       
     lvContents = lvContents + sql
     
     Const adSaveCreateNotExist = 1
     Const adSaveCreateOverWrite = 2
     Const adTypeBinary = 1
     Const adTypeText = 2
     
     Dim objStreamUTF8: Set objStreamUTF8 = CreateObject("ADODB.Stream")
     Dim objStreamUTF8NoBOM: Set objStreamUTF8NoBOM = CreateObject("ADODB.Stream")
     
     With objStreamUTF8
         .Charset = "UTF-8"
         .Open
         .WriteText lvContents
         .Position = 0
         .Type = adTypeText
         .Position = 3
     End With
     
     With objStreamUTF8NoBOM
         .Type = adTypeBinary
         .Open
         objStreamUTF8.CopyTo objStreamUTF8NoBOM
         .SaveToFile avFilePath, adSaveCreateOverWrite
     End With
     
     objStreamUTF8.Close
     objStreamUTF8NoBOM.Close

     MsgBox "文件生成成功！文件路径" + avFilePath


End Sub

'基础层CREATE
Sub Oracle建表sql()
    
    Dim avFilePath As String '文件路径
    Dim lvIntFileNum As Integer '空文件号
    Dim lvContents As String
    avFilePath = "F:\oracle_createtable_" & Format(Date, "yyyymmdd") & "_v1.0" & ".sql" '文件路径
    TargetSheetName = "建表语句"
    
     '生成建表hql
    Dim sql As String
    Dim cc As String
    Dim tableName As String             '表名
    Dim tableComm As String             '表注释
    Dim firstColumn As Integer          '是否首个字段
    Dim clusterColumn As String         '分桶字段
    Dim clusterNum  As String           '分桶数量
      Dim version_type  As String         '版本标志
      Dim PRIMARY As String               '主键'
       Dim PP As String               '主键'
      
            
        Set mysheet = Workbooks(1).Sheets(TargetSheetName)  '指定表名所在的sheet，根据实际修改
        For table_cnt = 2 To mysheet.UsedRange.Rows.Count '从第2行开始遍历所有的列
      
            Set mysheet = Workbooks(1).Sheets(TargetSheetName) '指定表名所在的sheet，根据实际修改
            
            tableName = mysheet.Range("B" & table_cnt).Value '英文表名，根据实际修改
            tableComm = mysheet.Range("A" & table_cnt).Value '中文表名，根据实际修改
                  version_type = mysheet.Range("C" & table_cnt).Value '版本标志
                  
                  
            
            If tableName <> "" And version_type = "1" Then
            
            clusterColumn = ""
            clusterNum = ""
            cc = ""
            PRIMARY = ""
            PP = ""
            'sql = sql & "DROP TABLE IF EXISTS XIBREW." & tableName & ";" & vbLf
            
            sql = sql & "CREATE TABLE " & tableName & "  ( " & vbLf
              
            Set mysheet = Workbooks(1).Sheets("Oracle数据库表设计") '指定字段名所在的sheet，根据实际修改
            firstColumn = 1
            For i = 2 To mysheet.UsedRange.Rows.Count '从第2行开始遍历所有的列
                Dim nameStr As String
                Dim typeStr As String
              
                If mysheet.Range("C" & i).Value = tableName Then
                    nameStr = mysheet.Range("D" & i).Value '字段名，根据实际修改
                    commStr = mysheet.Range("E" & i).Value '中文注释，根据实际修改
                    typeStr = mysheet.Range("F" & i).Value '数据类型，根据实际修改

                   If mysheet.Range("G" & i).Value = "是" Then          '是否主键
                        PRIMARY = mysheet.Range("D" & i).Value
                    End If
            
                    If firstColumn = 1 Then
                        sql = sql & "    " & nameStr & " " & typeStr & " NULL"
                    Else
                        sql = sql & "    ," & nameStr & " " & typeStr & " NULL"
                    End If
                   If PRIMARY <> "" Then
                        PP = clusterNum & "ALTER TABLE  " & tableName & " ADD CONSTRAINT PK_" & tableName & " PRIMARY KEY(" & PRIMARY & ");"
                    Else
                        PP = PRIMARY
                    End If
                    sql = sql & vbLf
                    cc = cc & "COMMENT ON COLUMN " & tableName & "." & nameStr & " IS '" & commStr & "';" & vbLf
                    firstColumn = firstColumn + 1
                End If
            
            Next i
        
            sql = sql & ");" & vbLf & "COMMENT ON TABLE " & tableName & " IS '" & tableComm & "';" & vbLf & cc & vbLf & PP & vbLf & vbLf & vbLf
            
            End If
        
        Next table_cnt
       
     lvContents = lvContents + sql
     
     Const adSaveCreateNotExist = 1
     Const adSaveCreateOverWrite = 2
     Const adTypeBinary = 1
     Const adTypeText = 2
     
     Dim objStreamUTF8: Set objStreamUTF8 = CreateObject("ADODB.Stream")
     Dim objStreamUTF8NoBOM: Set objStreamUTF8NoBOM = CreateObject("ADODB.Stream")
     
     With objStreamUTF8
         .Charset = "UTF-8"
         .Open
         .WriteText lvContents
         .Position = 0
         .Type = adTypeText
         .Position = 3
     End With
     
     With objStreamUTF8NoBOM
         .Type = adTypeBinary
         .Open
         objStreamUTF8.CopyTo objStreamUTF8NoBOM
         .SaveToFile avFilePath, adSaveCreateOverWrite
     End With
     
     objStreamUTF8.Close
     objStreamUTF8NoBOM.Close

     
     
     MsgBox "文件生成成功！文件路径" + avFilePath


End Sub

4. Excel测试文件下载

• 下载地址：
  数据库设计模板 + VBA创建sql语句.