???本文于2023年4月23日首发于本人同名公众号:Excel活学活用,更多文章敬请关注! ☆本期内容概要☆ 在前面一些的文章中,我有提到我在设计一个《财务管理系统》(不是近期分享的财务记账模板),有一个功能是数据导入。今天在使用的时候,想到数据检验的问题: 1、导入的Excel表的字段与Access表的字段是否一致(包括排列顺序)? 2、比如,在导入“会计凭证”的时候,检查Excel表中的会计科目是否已存在于Access数据库表? 今天花了点时间,初步实现异常数据校验功能,把过程写出来分享给大家,这是校验的结果,它列出了“不存在的字段“、”位置不同的字段“以及“不存在的数据记录”: 我们来看一下操作演示: 先说明一下背景: 1、图中的“甲有限公司(数据备份)20230423....“文件是我从这个财务管理系统中导出来的,字段名称及顺序是完全一致的。 2、然后,我把两个表中的字段名称改了一下,把【tb凭证】表中的科目代码改了两个、字段位置调换一些。 结果就如图所示,数据检验有异常,如果不做修改,应该是显示校验成功,不防再测试一下,我先导出,不做任何修改,立即做导入数据校验: 我们看一下代码(数据校验按钮): 简单解释一下代码: 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活学活用,更多文章敬请关注!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