夢幻之旅

DEBUG - 天道酬勤

:: 首頁 :: 新隨筆 :: 聯系 :: 聚合

:: 管理 ::

671 隨筆 :: 6 文章 :: 256 評論 :: 0 Trackbacks

(原創) VBA-Test

VERSION 1.0 CLASS

BEGIN

MultiUse = -1 'True

END

Attribute VB_Name = "Sheet3"

Attribute VB_GlobalNameSpace = False

Attribute VB_Creatable = False

Attribute VB_PredeclaredId = True

Attribute VB_Exposed = True

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Rem 模塊名稱: 生成插入SQL Rem

Rem 作者: Huyvanpull Rem

Rem 版本: V0.1 Rem

Rem 編寫時間: 2011.09.16 Rem

Rem 修改時間: 2011.09.16 Rem

Rem 功能描述: 根據數據Sheet的內容在另一個Sheet內生成插入SQL Rem

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Option Explicit

Const strTableNameCell = "A1" '表名所在的位置

Const intHeaderRow = 3 '數據表頭所在行

Const strDataSheetName = "數據源" '保存數據的Sheet名稱

Const strIsqlSheetName = "插入SQL" '保存SQL的Sheet名稱

Const strDeleSheetName = "刪除SQL" '存刪除SQL的Sheet名稱

Dim strTableName As String '數據庫表名

Dim strTemSql As String '臨時SQL語句

Dim strInsertSql As String '插入SQL語句

Dim intClumnCount As Integer '列數

Dim intIndex1 As Integer '索引變量

Dim intIndex2 As Integer '第二個索引變量

Dim intIndex3 As Integer '第三個變量

Rem 激活本Sheet時執行,生成插入SQL

Private Sub Worksheet_Activate()

Rem 清空SQL的Sheet

Worksheets(strIsqlSheetName).Select

Cells.Select

Selection.ClearContents

ActiveCell.Select

Rem 得到表名

strTableName = Worksheets(strDataSheetName).Range(strTableNameCell).Value

Rem 列數

intClumnCount = Worksheets(strDataSheetName).Range("IV" & intHeaderRow).End(xlToLeft).Column

Rem 開始組裝SQL語句

strTemSql = "INSERT INTO "

strTemSql = strTemSql + strTableName

strTemSql = strTemSql + " ("

Rem 組裝字段頭

For intIndex1 = 1 To intClumnCount

strTemSql = strTemSql + Worksheets(strDataSheetName).Cells(intHeaderRow, intIndex1).Value

If intIndex1 < intClumnCount Then

strTemSql = strTemSql + ","

End If

Next intIndex1

Rem 下條語句組裝TempSQL完成

strTemSql = strTemSql + ") VALUES ("

Rem 組裝SQL語句體

For intIndex2 = intHeaderRow + 1 To Worksheets(strDataSheetName).UsedRange.Rows.Count

strInsertSql = strTemSql

For intIndex3 = 1 To intClumnCount

Rem 加上單元格里的數據

strInsertSql = strInsertSql + getCellVal(Worksheets(strDataSheetName).Cells(intIndex2, intIndex3))

If intIndex3 < intClumnCount Then

strInsertSql = strInsertSql + ","

End If

Next intIndex3

strInsertSql = strInsertSql + ");"

Rem MsgBox strInsertSql

Rem 向插入SQL的Sheet賦值

Worksheets(strIsqlSheetName).Cells(intIndex2 - intHeaderRow, 1).Value = strInsertSql

Next intIndex2

Rem 設置插入SQL的Sheet的樣式

Worksheets(strIsqlSheetName).UsedRange.Select

With Selection

.Font.Size = 9 '設置字號Font.Name = "MS Sans Serif" '設置字體

.Font.Color = 1 '設置字的顏色Borders.LineStyle = xlContinuous '設置實線邊框

.Columns.AutoFit '設置單元格寬度自適應（根據單元格內文字都是自動調節該單元格的寬度）

End With

Rem 選中第一個單元格

Worksheets(strIsqlSheetName).Range("A1").Select

Rem 刪除SQL的Sheet的值

Worksheets(strDeleSheetName).Range("A1").Value = "--DELETE FROM " + strTableName + " WHERE 1=1"

Worksheets(strDeleSheetName).Range("A4").Value = " Write By: Huyvanpull"

Worksheets(strDeleSheetName).Range("A5").Value = " QQ: 182429125"

Worksheets(strDeleSheetName).Range("A6").Value = " Date: 2011-09-17"

End Sub

Rem 根據類型得到Cell里的值的函數

Function getCellVal(c)

Dim tempStr As String

Rem 如果單元格是數字

If IsNumeric(c.Value) Then

tempStr = "'"

Rem 如果不是整數,在前面加0

If Int(c.Value) <> c.Value Then

tempStr = tempStr + "0"

End If

tempStr = tempStr + CStr(c.Value)

tempStr = tempStr + "'"

Rem 如果單元格是是日期型

ElseIf IsDate(c.Value) Then

tempStr = "to_date('"

tempStr = tempStr + Format(c.Value, "yyyy-mm-dd hh:mm:ss")

tempStr = tempStr + " ','yyyy-mm-dd hh:mi:ss')"

Rem 如果單元格是其它數據類型

Else

tempStr = "'"

tempStr = tempStr + CStr(c.Value)

tempStr = tempStr + "'"

End If

Rem 返回字符串

getCellVal = tempStr

End Function

posted on 2011-09-17 00:43 HUIKK 閱讀(442) 評論(0) 編輯收藏所屬分類: VB/VBA/VBS

新用戶注冊刷新評論列表


只有注冊用戶登錄后才能發表評論。




網站導航: 博客園 IT新聞 Chat2DB C++博客博問管理
相關文章: excel2pdm vb 托盤 VBA 自定義函數 (原創) VBA 代碼的保護 (原創) VBA-Test

夢幻之旅

公告

常用鏈接

留言簿(21)

隨筆分類(644)

隨筆檔案(669)

文章檔案(6)

最新隨筆

積分與排名

最新評論

閱讀排行榜

評論排行榜