梦幻之旅

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 阅读(427) 评论(0)  编辑  收藏 所属分类: VB/VBA/VBS

只有注册用户登录后才能发表评论。
网站导航: