问题描述
简述:
有2份文件,分别是Summary.xlsm和Output.MDB。需要在Summary.xlsm写个VBA。内容是:
提取全部Summary.xlsm中sheet的名称,如果sheet的名称,在Output.MDB中找到资料表的名称是字符串"Fruit - "加上对应sheet名称,它们两个内容是不一样的,则输出弹窗(所有sheet的名称),如果一致则输出弹窗(“Well Done!”)。
代码描述
- 循环遍历
Summary.xlsm
中的所有工作表。 - 对于每个工作表,构造
Output.MDB
中的表名(即"Fruit - "
加上工作表名称)。 - 打开
Output.MDB
数据库,检查表是否存在,并对其进行比较。比较内容是sheet中第三行开始,A-G列的全部有值单元格和Access中的资料表对应单元格。 - 如果存在任何不一致,记录下来并最后显示一个包含所有不一致名称的弹窗。
- 如果全部一致,则显示弹窗,显示
"Well Done!"
。
Sub CompareSheetsWithDatabaseTables()
Dim ws As Worksheet
Dim sheetName As String
Dim tableName As String
Dim conn As Object
Dim rst As Object
Dim sql As String
Dim col As Integer
Dim row As Integer
Dim excelValue As String
Dim dbValue As String
Dim isWellDone As Boolean
Dim dbName As String
Dim mismatchList As String
dbName = ThisWorkbook.Path & "\Output.MDB" ' 指定数据库文件路径
mismatchList = ""
isWellDone = True
' 设置数据库连接字符串
Set conn = CreateObject("ADODB.Connection")
conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbName
For Each ws In ThisWorkbook.Sheets
sheetName = ws.Name
tableName = "Fruit - " & sheetName
' 检查表是否存在
sql = "SELECT TOP 1 * FROM [" & tableName & "]"
Set rst = CreateObject("ADODB.Recordset")
On Error Resume Next
rst.Open sql, conn, 1, 1 ' 1, 1 = adOpenKeyset, adLockReadOnly
If Err.Number <> 0 Then
' 表不存在或无法打开
isWellDone = False
mismatchList = mismatchList & tableName & " (Table not found or cannot open)" & vbNewLine
Err.Clear
Else
On Error GoTo 0
' 逐行逐列进行比较
For row = 3 To ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
For col = 1 To 7 ' A到G列
excelValue = ws.Cells(row, col).Value
dbValue = rst.Fields(col - 1).Value ' 记录集字段索引从 0 开始
' 如果 Excel 单元格有值,则比较
If Not IsEmpty(excelValue) Then
If excelValue <> dbValue Then
' 内容不一致
isWellDone = False
mismatchList = mismatchList & tableName & " (Mismatch in Cell " & ws.Cells(row, col).Address & ")" & vbNewLine
Exit For ' 跳出循环,继续检查下一张表
End If
End If
Next col
If Not isWellDone Then Exit For ' 如果已经有不一致,跳出行循环
rst.MoveNext ' 移动到下一条记录
If rst.EOF Then Exit For ' 如果记录集结束,跳出行循环
Next row
End If
rst.Close
Next ws
conn.Close
' 展示结果
If isWellDone Then
MsgBox "Well Done!", vbInformation
Else
MsgBox "The following mismatches were found:" & vbNewLine & mismatchList, vbCritical
End If
End Sub
注意
- 需要引用适当的 ActiveX 数据对象库。在 VBA 编辑器中,通过 “工具” -> “引用…”,然后选择 “Microsoft ActiveX Data Objects X.X Library”。
- 在比较之前,上面的代码假定 Excel 工作表和 Access 表中的行数是一致的。如果行数不一致,需要添加额外的逻辑来处理这种情况。
- 在实际应用中,如果数据库较大或者表很多,上述代码可能运行较慢。
- 错误处理在这个脚本中很基本,仅用于继续执行循环。根据实际需要,可能要添加更复杂的错误处理机制。
- 确保将
dbName
设置为正确的Output.MDB
文件路径。 - 由于 Access SQL 查询不区分大小写,而 VBA 比较默认是区分大小写的,这可能会影响比较结果。如果需要,可以使用 StrComp 函数来进行不区分大小写的比较。