玖叶教程网

前端编程开发入门

Excel VBA Excel表格数据导入Access数据库/数据校验初探

???本文于2023年4月23日首发于本人同名公众号:Excel活学活用,更多文章敬请关注

☆本期内容概要☆

  • Excel表格数据导入Access数据库前的数据校验

在前面一些的文章中,我有提到我在设计一个《财务管理系统》(不是近期分享的财务记账模板),有一个功能是数据导入。今天在使用的时候,想到数据检验的问题:

1、导入的Excel表的字段与Access表的字段是否一致(包括排列顺序)?

2、比如,在导入“会计凭证”的时候,检查Excel表中的会计科目是否已存在于Access数据库表?

今天花了点时间,初步实现异常数据校验功能,把过程写出来分享给大家,这是校验的结果,它列出了“不存在的字段“、”位置不同的字段“以及“不存在的数据记录”:

我们来看一下操作演示:

先说明一下背景:

1、图中的“甲有限公司(数据备份)20230423....“文件是我从这个财务管理系统中导出来的,字段名称及顺序是完全一致的。

2、然后,我把两个表中的字段名称改了一下,把【tb凭证】表中的科目代码改了两个、字段位置调换一些。

结果就如图所示,数据检验有异常,如果不做修改,应该是显示校验成功,不防再测试一下,我先导出,不做任何修改,立即做导入数据校验:

我们看一下代码(数据校验按钮):


Private Sub CmdValidation_Click()
   Dim xlcnn As Object   '数据库连接,连接excel
    Dim xlrs As Object   '记录集对象
    Dim xlStrCnn As String     'Excel SQL 查询连接语句
    Dim xlData()    '数组,存放记录
    Dim xlTitle()   '数组,存放excel表头
    Dim acTitle()   '数组,存放Access表头
    Dim Msg As String, strCheck As String   '存放校验结果信息
    Dim arr()    '数组,存放从access中查询的校验数据
    On Error Resume Next
    Set xlcnn = CreateObject("ADODB.Connection")
    Set xlrs = CreateObject("ADODB.Recordset")
    xlStrCnn = clsGT.GetStrCnn(sFile)   '自定义函数,生成查询连接字符串
    xlcnn.Open xlStrCnn    '打开连接
    For Each LvItem In Me.LvSelected.ListItems  '循环选择的每一个表
        CurrTable = LvItem.Text
        SQL1 = " select * from  [" & CurrTable & "$]"
        Set xlrs = xlcnn.Execute(SQL1)
        xlData = xlrs.getrows
        n = xlrs.Fields.Count - 1
        ReDim xlTitle(n)
        For i = 0 To n
            xlTitle(i) = xlrs.Fields(i).Name
        Next
        sql = "select * from " & CurrTable
        acTitle = clsDQ.GetFields(sql)
        If UBound(acTitle) <> n Then
            Msg = Msg & "【" & CurrTable & "】字段数量不一致" & Chr(10)
        Else
          strCheck = Join(acTitle, "/")
            strCheck = "/" & strCheck & "/"
            For i = 0 To n
                If InStr(strCheck, xlTitle(i)) = 0 Then
                    Msg = Msg & "【" & CurrTable & "】【" & xlTitle(i) & "】字段不存在" & Chr(10)
                Else
                    If xlTitle(i) <> acTitle(i) Then
                        Msg = Msg & "【" & CurrTable & "】【" & xlTitle(i) & "<--> " & acTitle(i) & "】字段位置不同" & Chr(10)
                        'Stop
                    End If
                End If
            Next
        End If
        If CurrTable = "tb凭证" Then
            Dim PosAccCode As Integer
            arr = clsDQ.GetData("select 科目代码 from tb科目")
            strCheck = Join(FlattenArray(arr), "/")
            strCheck = "/" & strCheck & "/"
            PosAccCode = Pxy(xlTitle, "科目代码") - 1
            For k = 0 To UBound(xlData, 2)
                If InStr(strCheck, xlData(PosAccCode, k)) = 0 Then
                    Msg = Msg & "【" & CurrTable & "】【" & xlData(PosAccCode, k) & "】科目代码不存在" & Chr(10)
                End If
            Next
        End If
    Next
    If Msg = "" Then
        MsgBox "字段校验无误!"
    Else
        MsgBox Msg
    End If
End Sub


简单解释一下代码:

1、定义变量

2、从用户窗体右边的listivew循环读取要校验的表名

3、把列表中的Excel表的字段名存入数组xlTitle

4、循环xlTitle,查询Access数据库中同名的表,字段存入acTitle

5、比较xlTitle与acTitle字段的数据、名称、位置,如果有不相同的记录,把它记入Msg

6、字段比较完了,再比较相关记录,这里我们暂时就搞了一个【tb凭证】表中,科目代码是否在Access数据库的【tb科目】中存在。

7、结束比较,如果没有异常,则Msg为空,我们输出提示信息“字段校验无误“,否则,则输出Msg的内容,我们可以看到是哪里出了问题。


Excel导入Access的主要代码我放在第二条,由于时间关系,不多解释了,感兴趣的小伙伴可以自行观摩。

好,今天就分享到这。由于这个代码无法独立运行,大家参考思路即可,我们下期再会。


☆猜你喜欢☆

Excel VBA 这样酷炫的日期控件,你不想要吗?

Excel 公式函数/数据透视表/固定资产折旧计提表!

Excel VBA 自定义函数/数组字段定位/数组字段排序

Excel 功能/公式函数/VBA/多种姿势处理重复值

Excel VBA 最简单的收发存登记系统

Excel 公式函数/查找函数之LOOKUP

Excel VBA 文件批量改名

Excel 公式函数/数据验证/动态下拉列表

Excel VBA 输入逐步提示/TextBox+ListBox

Excel 基础功能【数据验证】,你会怎么用?


????本文于2023年4月23日首发于本人同名公众号:Excel活学活用,更多文章敬请关注

发表评论:

控制面板
您好,欢迎到访网站!
  查看权限
网站分类
最新留言