直接上代码

Private Sub SQL嶌惉_Click() For si = 2 To Workbooks(1).Sheets.Count Set mysheet = Workbooks(1).Sheets(si) tableName = mysheet.Range("AM4").Value 'SQL = SQL & "if exists (select * from sysobjects where name='" & tableName & "') " & vbCrLf 'drop table tableName 'SQL = SQL & " drop table [" & tableName & "] " & vbCrLf 'SQL = SQL & "go " & vbCrLf Dim SQL As String 'create table tableName ( SQL = SQL & "create table [" & tableName & "] ( " & vbCrLf '嵟戝峴悢 mysheet.UsedRange.Rows.Count - 6 MsgBox mysheet.UsedRange.Rows.Count For i = 6 To mysheet.UsedRange.Rows.Count - 6 Dim nameStr As String Dim typeStr As String Dim typeLength As String Dim com As String 'lieming nameStr = mysheet.Range("P" & i).Value 'leixing typeStr = mysheet.Range("AE" & i).Value 'zhushi refStr = mysheet.Range("E" & i).Value ' changdu typeLength = mysheet.Range("AM" & i).Value If nameStr <> "" And typeStr <> "" Then If i = 6 Then SQL = SQL & " [" & nameStr & "] " & typeStr & " primary key not null" 'primary key Else SQL = SQL & " [" & nameStr & "] " & typeStr & "(" & typeLength & ")" End If If i < mysheet.UsedRange.Rows.Count - 6 Then SQL = SQL & "," End If com = com & "COMMENT ON COLUMN " & tableName & "." & nameStr & " IS '" & refStr & "';" & vbCrLf SQL = SQL & vbCrLf End If Next i SQL = SQL & ")" & vbCrLf SQL = SQL & "go" & vbCrLf SQL = SQL & com & vbCrLf com = "" SQL = SQL & "-----Create table [" & tableName & "] end." & vbCrLf & vbCrLf Next si TextBox1.Value = SQL End Sub

注意：通常的时候，excel保存不了，关闭excel直接没了，另存为xlsm格式就可以了。