在VBA中打开并定义两个excel文件

Question

作为一个更大的宏的一部分，并且需要打开和定义两个工作簿和工作表。 （我知道我将我的工作表定义为Variant，我需要这个用于futhure操作）。当我尝试为SheetRI设置价值时出现错误。有没有人看到它可能是什么？提前致谢！

Sub compareQRTsAll() 

Dim ActiveWb As Workbook 
Dim ActiveSh As Worksheet 
Dim SheetFasit As Variant 
Dim SheetRI As Variant 
Dim FolderFasit As String 
Dim FileFasit As String 
Dim FolderRI As String 
Dim FileRI As String 
Dim WbFasit As Workbook 
Dim WbRI As Workbook 
Dim WbFasitPath As String 
Dim strRangeToCheck As String 
Dim nShFasit As Integer 
Dim nShRI As Integer 
Dim iRow As Long 
Dim iCol As Long 
Dim i As Integer 
Dim j As Integer 
i = 2 
j = 6 

Set ActiveWb = ActiveWorkbook 
Set ActiveSh = ActiveWb.Worksheets(1) 
strRangeToCheck = "A1:AAA1000" 
ActiveSh.Range("A2:D10000").Clear 

FolderFasit = ActiveSh.Range("J6") 
FolderRI = ActiveSh.Range("J7") 

Do While ActiveSh.Cells(j, 8) <> "" 

FileFasit = Dir(FolderFasit & "\*" & ActiveSh.Cells(j, 8) & "*.xls*") 
Set WbFasit = Workbooks.Open(Filename:=FolderFasit & "\" & FileFasit) 
SheetFasit = WbFasit.Worksheets(1).Range(strRangeToCheck) 
nShFasit = WbFasit.Sheets.Count 

FileRI = Dir(FolderRI & "\*" & ActiveSh.Cells(j, 8) & "*.xls*") 
Set WbRI = Workbooks.Open(Filename:=FolderRI & "\" & FileRI) 
SheetRI = WbRI.Worksheets(1).Range(strRangeToCheck) '<-------------THIS DOESN'T WORK 
nShRI = WbRI.Sheets.Count 


If nShFasit <> nShRI Then 
    MsgBox "QRT " & ActiveSh.Cells(j, 8) & " has different number of sheets in fasit and in RI. Further check will not be performed" 

    ElseIf nShFasit = nShRI And nShFasit = 1 Then 

For iRow = LBound(SheetFasit, 1) To UBound(SheetFasit, 1) 
    For iCol = LBound(SheetFasit, 2) To UBound(SheetFasit, 2) 
     If SheetFasit(iRow, iCol) = SheetRI(iRow, iCol) Then 

      ' Do nothing. 
     Else 
      ActiveSh.Cells(i, 1) = "Check row " & iRow & ", column " & iCol & " in " & ActiveSh.Cells(j, 8) 
      ActiveSh.Cells(i, 2) = SheetFasit(iRow, iCol) 
      ActiveSh.Cells(i, 3) = SheetRI(iRow, iCol) 
      i = i + 1 
     End If 
    Next iCol 
Next iRow 

End If 


'close workbooks 

昏暗WB作为工作簿 对于每个WB在工作簿 如果不Wb的ActiveWb然后 wb.Close的SaveChanges：=假 结束如果 接着WB

当J = J + 1 环路 End Sub

Answer 1

问题出在范围strRangeToCheck =“A1：AAA1000”。我的一些文件保存为.xls和存在于Excel 2003中没有AAA列

昏暗FolderRI作为字符串 昏暗FileRI作为字符串 昏暗WbFasit作为工作簿 昏暗WbRI作为工作簿 昏暗WbFasitPath作为字符串 暗淡strRangeToCheck作为字符串 昏暗nShFasit作为整数 昏暗nShRI作为整数 昏暗iRow只要 昏暗ICOL只要 昏暗我作为整数 昏暗J所示整数 I = 2 J = 6

Set ActiveWb = ActiveWorkbook 
Set ActiveSh = ActiveWb.Worksheets(1) 
strRangeToCheck = "A1:IV1000" 
ActiveSh.Range("A2:D10000").Clear 


' If you know the data will only be in a smaller range, reduce the size of the ranges above. 

'FolderFasit = InputBox("Enter path to the forder with correct QRTs") 
'FolderRI = InputBox("Enter path to the forder with QRTs from RI") 
FolderFasit = ActiveSh.Range("J6") 
FolderRI = ActiveSh.Range("J7") 

Do While ActiveSh.Cells(j, 8) <> "" 

FileFasit = Dir(FolderFasit & "\*" & ActiveSh.Cells(j, 8) & "*.xls*") 
Set WbFasit = Workbooks.Open(Filename:=FolderFasit & "\" & FileFasit) 
SheetFasit = WbFasit.Worksheets(1).Range(strRangeToCheck) 
nShFasit = WbFasit.Sheets.Count 

FileRI = Dir(FolderRI & "\*" & ActiveSh.Cells(j, 8) & "*.xls*") 
Set WbRI = Workbooks.Open(Filename:=FolderRI & "\" & FileRI) 
Debug.Print FileRI 
SheetRI = WbRI.Worksheets(1).Range(strRangeToCheck) 
nShRI = WbRI.Sheets.Count 


If nShFasit <> nShRI Then 
    MsgBox "QRT " & ActiveSh.Cells(j, 8) & " has different number of sheets in fasit and in RI. Further check will not be performed" 

    ElseIf nShFasit = nShRI And nShFasit = 1 Then 

For iRow = LBound(SheetFasit, 1) To UBound(SheetFasit, 1) 
    For iCol = LBound(SheetFasit, 2) To UBound(SheetFasit, 2) 
     If SheetFasit(iRow, iCol) = SheetRI(iRow, iCol) Then 

      ' Do nothing. 
     Else 
      ActiveSh.Cells(i, 1) = "Check row " & iRow & ", column " & iCol & " in " & ActiveSh.Cells(j, 8) 
      ActiveSh.Cells(i, 2) = SheetFasit(iRow, iCol) 
      ActiveSh.Cells(i, 3) = SheetRI(iRow, iCol) 
      i = i + 1 
     End If 
    Next iCol 
Next iRow 

End If 


'close workbooks 

昏暗WB作为工作簿 对于每个WB在工作簿 如果不Wb的ActiveWb然后 wb.Close的SaveChanges：=假 结束如果 接着WB

当J = J + 1 循环 结束子