|
核对数据的公式代码,在测试文件阶段的时候成功核对出错误数据,到真正用到实际文件的时候就代码就合不出来了错误数据了,不好使了,这是为什么,求大神帮忙解救一下,谢谢!
Sub lqxs6()
Dim Arr, myPath$, nm$, I&, Brr, aa, r, r1, l, l1, y&, j&, n&
Dim d, k, t, wk1 As Workbook, wk2 As Workbook, Crr
Set d = CreateObject("Scripting.Dictionary")
Dim Sht As Worksheet
Set wk1 = ThisWorkbook
For Each Sht In Sheets
d(Sht.Name) = ""
Next
'Brr = Sheet3.[b1].CurrentRegion
'Brr = Sheet3.Range([b1], [b65536].End(3))
Brr = Sheet3.Range("b1:b" & Sheet3.[b65536].End(xlUp).Row) '对应-----bbbbb------这个才能正常运行
'myPath = ThisWorkbook.Path & "\b.xlsx"'-----固定打开工作簿---------对应aaa-----
'myPath = ("C:\Users\Administrator\Desktop\测试\同名表多表格数据的核对\b.xlsx")'-----固定打开工作簿---------对应aaa2222-----
Dim fileName
fileName = Application.GetOpenFilename("EXCEL文件(*.xls;*.xlsx;*.csv;*.xlsm), *.xls;*.xlsx;*.csv;*.xlsm") '手动打开工作簿
' 打开数据源文件
'fileName = Application.GetOpenFilename(FileFilter:="Excel 文件 (*.xls;*.xlsx;*.csv;*.xlsm),*.xls;*.xlsx;*.csv;*.xlsm", MultiSelect:=True)
'Workbooks.Open fileName:=fileName
' With ActiveWorkbook
'With GetObject(myPath)
With GetObject(fileName)
' Set wk2 = .GetFolder(ThisWorkbook.Path & "\b.xlsx")
''' Set wk2 = Workbooks("b.xlsx")'-----对应aaa-----
' Set wk2 = Workbooks(myPath)
Set wk2 = Workbooks.Open(fileName) '指定手动打开的工作簿作为函数-----对应bbbbb--------
' Set wk2 = Workbooks("B.xlsx").Sheets(3).[B65536].End(xlUp).Row + 1-----对应bbbbb--------
For I = 1 To UBound(Brr)
s = Brr(I, 1) & "表格中有以下不同的单元格:" & vbCrLf
If d.exists(wk2.Sheets(I).Name) Then
Arr = wk1.Sheets(Brr(I, 1)).UsedRange
Crr = wk2.Sheets(Brr(I, 1)).UsedRange
For X = 1 To UBound(Arr)
For y = 1 To UBound(Arr, 2)
' If Arr(x, y) <> Crr(x, y) Then s = s & x & "|" & y & vbCrLf’这个显示数字坐标
If Arr(X, y) <> Crr(X, y) Then s = s & Cells(X, y).Address(0, 0) & vbCrLf '这个显示字母坐标
Next
Next
'If InStr(s, "|") <> 0 Then MsgBox s’对应显示数字坐标
If s <> 0 Then MsgBox s '对应显示字母坐标
Else
MsgBox s & "表格没有不同。"
End If
Next
wk2.Close False '关闭指定工作簿
End With
End Sub
上面成功了
- Sub lqxs6()
- Dim Arr, myPath$, nm$, I&, Brr, aa, r, r1, l, l1, y&, j&, n&
- Dim d, k, t, wk1 As Workbook, wk2 As Workbook, Crr
- Set d = CreateObject("Scripting.Dictionary")
- Dim Sht As Worksheet
- Set wk1 = ThisWorkbook
- For Each Sht In Sheets
- d(Sht.Name) = ""
- Next
- 'Brr = Sheet3.[b1].CurrentRegion
- 'Brr = Sheet3.Range([b1], [b65536].End(3))
- Brr = Sheet60.Range("b2:b" & Sheet60.[b65536].End(xlUp).Row) '对应-----bbbbb------这个才能正常运行
- 'myPath = ThisWorkbook.Path & "\b.xlsx"'-----固定打开工作簿---------对应aaa-----
- 'myPath = ("C:\Users\Administrator\Desktop\测试\同名表多表格数据的核对\b.xlsx")'-----固定打开工作簿---------对应aaa2222-----
- Dim fileName
- ' fileName = Application.GetOpenFilename("EXCEL文件(*.xls;*.xlsx;*.csv;*.xlsm), *.xls;*.xlsx;*.csv;*.xlsm") '手动打开工作簿
- fileName = Application.GetOpenFilename("EXCEL文件(*.xlsm),*.xlsm") '手动打开工作簿
-
- ' 打开数据源文件
- 'fileName = Application.GetOpenFilename(FileFilter:="Excel 文件 (*.xls;*.xlsx;*.csv;*.xlsm),*.xls;*.xlsx;*.csv;*.xlsm", MultiSelect:=True)
- 'Workbooks.Open fileName:=fileName
- ' With ActiveWorkbook
- 'With GetObject(myPath)
- With GetObject(fileName)
- ' Set wk2 = .GetFolder(ThisWorkbook.Path & "\b.xlsx")
- ''' Set wk2 = Workbooks("b.xlsx")'-----对应aaa-----
- ' Set wk2 = Workbooks(myPath)
- Set wk2 = Workbooks.Open(fileName) '指定手动打开的工作簿作为函数-----对应bbbbb--------
-
- ' Set wk2 = Workbooks("B.xlsx").Sheets(3).[B65536].End(xlUp).Row + 1-----对应bbbbb--------
-
- For I = 1 To UBound(Brr)
- s = Brr(I, 1) & "表格中有以下不同的单元格:" & vbCrLf
- If d.exists(wk2.Sheets(I).Name) Then
- Arr = wk1.Sheets(Brr(I, 1)).UsedRange
- Crr = wk2.Sheets(Brr(I, 1)).UsedRange
- For X = 1 To UBound(Arr)
- For y = 1 To UBound(Arr, 2)
-
- ' If Arr(x, y) <> Crr(x, y) Then s = s & x & "|" & y & vbCrLf’这个显示数字坐标
-
- If Arr(X, y) <> Crr(X, y) Then s = s & Cells(X, y).Address(0, 0) & vbCrLf '这个显示字母坐标
-
- Next
- Next
- 'If InStr(s, "|") <> 0 Then MsgBox s’对应显示数字坐标
- If s <> 0 Then MsgBox s '对应显示字母坐标
- Else
- MsgBox s & "表格没有不同。"
-
- End If
- Next
- wk2.Close False '关闭指定工作簿
- End With
- End Sub
复制代码 这个失败了
|
|