《从Excel到Access》课程第7课VBA代码

来源:www.accessoft.com 点击数:4777 　 | 收藏 | 复制

时　间:2018-04-02 20:04:53
作　者:张志 ID：8 城市：上海 QQ：2851379730
摘　要:第7课《输出到Excel（1）》中的VBA代码，供学员参考。
正　文:

《从Excel到Access数据库》课程是为广大Excel用户了解、学习Access开设的一个实用课程，侧重于数据统计分析。本课程选取的案例是对银行年化贷款收益率分析，在这个案例中，数据记录达60多万条，根据工作需要，定期每月分析1-2次。银行的分析师是一位熟练的Excel用户，他每次制作本报表用EXCEL需要花费1小时左右，改用Access数据库后只需要花90秒。

>>单击此进入《从Excel到Access数据库》课程

示例代码如下：

1.给公司条线的类型和产品名称加上序号

Private Sub AddSerialNumber1()
       
    Dim rst As DAO.Recordset
    Dim strSQL As String
    Dim i As Integer
    Dim OldType As String
    
    '更新报表用的类型
    DoCmd.RunSQL "Update tbl年化贷款收益率 SET tbl年化贷款收益率.类型 = '1.1.1 大型'" _
        & " Where 类型='1、大型' AND 条线='1.1 公司条线（人民币）'"
    DoCmd.RunSQL "Update tbl年化贷款收益率 SET tbl年化贷款收益率.类型 = '1.1.2 中型'" _
        & " Where 类型='2、中型' AND 条线='1.1 公司条线（人民币）'"
    DoCmd.RunSQL "Update tbl年化贷款收益率 SET tbl年化贷款收益率.类型 = '1.1.3 小型'" _
        & " Where 类型='3、小型' AND 条线='1.1 公司条线（人民币）'"
    DoCmd.RunSQL "Update tbl年化贷款收益率 SET tbl年化贷款收益率.类型 = '1.1.4 微型'" _
        & " Where 类型='4、微型' AND 条线='1.1 公司条线（人民币）'"
    DoCmd.RunSQL "Update tbl年化贷款收益率 SET tbl年化贷款收益率.类型 = '1.1.5 非企业(为空值)'" _
        & " Where 类型='5、非企业' AND 条线='1.1 公司条线（人民币）'"
    
    strSQL = "select 条线, 类型, 产品名称, 产品序号 from tbl年化贷款收益率 where 条线='1.1 公司条线（人民币）' order by 类型, 产品名称"
    Set rst = CurrentDb.OpenRecordset(strSQL)
    rst.MoveFirst '移到第一行记录
    OldType = "类型"
    
    Do Until rst.EOF
        rst.Edit
        If rst!类型 <> OldType Then '如果类型与上一条记录不同，从1开始
            i = 1
        End If
        Select Case rst!类型
        Case "1.1.1 大型"
            rst!产品名称 = "1.1.1." & i & " " & rst!产品名称
        Case "1.1.2 中型"
            rst!产品名称 = "1.1.2." & i & " " & rst!产品名称
        Case "1.1.3 小型"
            rst!产品名称 = "1.1.3." & i & " " & rst!产品名称
        Case "1.1.4 微型"
            rst!产品名称 = "1.1.4." & i & " " & rst!产品名称
        Case "1.1.5 非企业(为空值)"
            rst!产品名称 = "1.1.5." & i & " " & rst!产品名称
        End Select
        rst!产品序号 = i
        rst.Update
        OldType = rst!类型
        
        rst.MoveNext
        i = i + 1
    Loop
    rst.Close
    Set rst = Nothing
    
End Sub

2.给零售条线的类型和产品名称加上序号

Private Sub AddSerialNumber2()
    Dim rst As DAO.Recordset
    Dim strSQL As String
    Dim i As Integer
    Dim OldType As String
    
    '更新报表用的类型
    DoCmd.RunSQL "Update tbl年化贷款收益率 SET tbl年化贷款收益率.类型 = '1.2.1 农户'" _
        & " Where 类型='农户' AND 条线='1.2 零售条线（人民币）'"
    DoCmd.RunSQL "Update tbl年化贷款收益率 SET tbl年化贷款收益率.类型 = '1.2.2 非农户'" _
        & " Where 类型='非农户' AND 条线='1.2 零售条线（人民币）'"
    
    
    strSQL = "select 条线, 类型, 产品名称, 产品序号 from tbl年化贷款收益率 where 条线='1.2 零售条线（人民币）' order by 类型, 产品名称"
    Set rst = CurrentDb.OpenRecordset(strSQL) '用DAO打开记录集
    rst.MoveFirst
    OldType = "类型"
    Do Until rst.EOF
        rst.Edit '允许编辑
        If rst!类型 <> OldType Then
            i = 1
        End If
        Select Case rst!类型
        Case "1.2.1 农户"
            rst!产品名称 = "1.2.1." & i & " " & rst!产品名称
        Case "1.2.2 非农户"
            rst!产品名称 = "1.2.2." & i & " " & rst!产品名称
        End Select
        rst!产品序号 = i
        rst.Update '更新数据
        OldType = rst!类型
        
        rst.MoveNext '指针移到下一条记录
        i = i + 1
    Loop
    rst.Close
    Set rst = Nothing
    
End Sub

3.给国业条线的类型和产品名称加上序号，国业是指国际业务

Private Sub AddSerialNumber3()
    Dim rst As DAO.Recordset
    Dim strSQL As String
    Dim i As Integer
    Dim OldType As String
    
    '更新报表用的类型
    DoCmd.RunSQL "Update tbl年化贷款收益率 SET tbl年化贷款收益率.类型 = '1.3.1 大型'" _
        & " Where 类型='1、大型' AND 条线='1.3 国业条线（外币）'"
    DoCmd.RunSQL "Update tbl年化贷款收益率 SET tbl年化贷款收益率.类型 = '1.3.2 中型'" _
        & " Where 类型='2、中型' AND 条线='1.3 国业条线（外币）'"
    DoCmd.RunSQL "Update tbl年化贷款收益率 SET tbl年化贷款收益率.类型 = '1.3.3 小型'" _
        & " Where 类型='3、小型' AND 条线='1.3 国业条线（外币）'"
    DoCmd.RunSQL "Update tbl年化贷款收益率 SET tbl年化贷款收益率.类型 = '1.3.4 微型'" _
        & " Where 类型='4、微型' AND 条线='1.3 国业条线（外币）'"
    
    
    strSQL = "select 条线, 类型, 产品名称, 产品序号 from tbl年化贷款收益率 where 条线='1.3 国业条线（外币）' order by 类型, 产品名称"
    Set rst = CurrentDb.OpenRecordset(strSQL) '用DAO打开记录集
    rst.MoveFirst
    OldType = "类型"
    Do Until rst.EOF
        rst.Edit '允许编辑
        If rst!类型 <> OldType Then
            i = 1
        End If
        Select Case rst!类型
        Case "1.3.1 大型"
            rst!产品名称 = "1.3.1." & i & " " & rst!产品名称
        Case "1.3.2 中型"
            rst!产品名称 = "1.3.2." & i & " " & rst!产品名称
        Case "1.3.3 小型"
            rst!产品名称 = "1.3.3." & i & " " & rst!产品名称
        Case "1.3.4 微型"
            rst!产品名称 = "1.3.4." & i & " " & rst!产品名称
        End Select
        rst!产品序号 = i
        
        rst.Update '更新数据
        OldType = rst!类型
        
        rst.MoveNext '移到下一条记录
        i = i + 1
    Loop
    rst.Close
    Set rst = Nothing
    
End Sub

4.给记录加上顺序号，以便将来按顺序输出到Excel，因为条线和类型的值只在一条记录中保留，没有这个顺序号，将无法按顺序输出数据到Excel

Private Sub RecordsSerialNumber()
    Dim rst As DAO.Recordset
    Dim strSQL As String
    Dim i As Integer
    strSQL = "select 条线, 类型, 产品序号, 顺序号 from tbl年化贷款收益率 order by 条线, 类型, 产品序号"
    Set rst = CurrentDb.OpenRecordset(strSQL) '用DAO打开记录集
    rst.MoveFirst
    i = 1
    Do Until rst.EOF
        rst.Edit '允许编辑
        rst!顺序号 = i
        rst.Update '更新数据
        i = i + 1
        rst.MoveNext '移到下一条记录
    Loop
    rst.Close
    Set rst = Nothing
End Sub

5.'对相同条线、类型只保留第一条记录的值，其他的删除

Private Sub DeleteSerialNumber()
    Dim rst As DAO.Recordset
    Dim strSQL As String
    Dim OldLine As String
    Dim OldType As String '类型  
    strSQL = "select 条线, 类型, 产品序号 from tbl年化贷款收益率 order by 条线, 类型, 产品序号"
    Set rst = CurrentDb.OpenRecordset(strSQL) '用DAO打开记录集
    rst.MoveFirst
    OldLine = rst!条线
    rst.MoveNext
    Do Until rst.EOF
        If rst!条线 = OldLine Then
            rst.Edit
            OldLine = rst!条线
            rst!条线 = Null
            rst.Update '更新数据
        Else
            OldLine = rst!条线
        End If
        rst.MoveNext '移到下一条记录
    Loop
    rst.Close
    Set rst = Nothing
    DoCmd.OpenQuery "qry清空类型的序号"
End Sub

Access软件网QQ交流群 (群号:483923997) 　　　　　　Access源码网店

【打印此文】【关闭窗口】