VBAで2つのExcelファイルを開いて定義する

Question

大きなマクロの一部として、2つのブックとシートを開き、定義する必要があります。 （私はワークシートをVariantとして定義していることを認識していますが、これはfuture操作に必要です）。私は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です：= Falseの END IF 次のWB

J = J + 1 ループ End Sub

Answer 1

問題は範囲strRangeToCheck = "A1：AAA1000"にありました。私のファイルの一部が.XLSとして保存され、およびExcel 2003

文字列 列 ワークブック ワークブック 文字列 薄暗いとして暗いWbFasitPathとして暗いWbRIとして暗いWbFasitとして暗いFileRIとして暗いFolderRIにはAAAの列はありませんstrRangeToCheck整数 暗いiRowとして整数 暗いnShRIとして文字列 暗いnShFasit限り 暗いICOL限り 暗いとしてI整数 として整数暗い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その後 wb.CloseのSaveChanges ActiveWbです：= Falseの END IF 次のWB

J = J + 1 ループ End Subの