2つのワークブックを比較する際の問題

Question

2つの異なるワークブックのワークシートを比較しようとしていますが、この権利を得ることはできません。私は配列を使用することが非効率であることを何度も読んだことがありますが、たびに提案された解決策を試してみるとどこにも行きません。

私はそれが配列の充填に関連しているが、それは1から（このCASE_ 1487で）の範囲の外Iであってはならないデバッグする場合、次のような問題が範囲外

を ランタイムエラー9添字が起こっています1486にエラーがあるので、まだ範囲内です。

は、私はプログラムが継続するエラーをバイパスするエラー後藤0

に持っていますが、別のレコードを印刷しません上部のように、他の問題がある場合は、私が見ることができるように、このエラーをスキップしたいです。誰かがこれを見ることができるなら、私は非常に感謝します。

は私が

Option Base 1 

Sub GatherInfo() 

Dim CurrentRecord() As Variant 
Dim PreviousRecord() As Variant 
Dim ChangedRecord() As Variant 

Dim WasCancled As Integer 
Dim RecordChange As Integer 

Dim CurrentFile As String 
Dim PreviousFile As String 
Dim CurrentWB As Excel.Workbook 
Dim PreviousWB As Excel.Workbook 

Dim OldRC As Integer 
Dim NewRC As Integer 
Dim OldCC As Integer 
Dim NewCC As Integer 
Dim MaxRC As Integer 
Dim MaxCC As Integer 



'Allow user to select the older version of the dBase 

Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = False 'Allow only one fiel selection 

'Application.FileDialog(msoFileDialogOpen).InitialFileName = "C:\Users\bkrukowski\Desktop\Paving DataBase" 'Point to the file folder 

Application.FileDialog(msoFileDialogOpen).Title = "SELECT THE OLDER VERSION FOR COMPARISON:" ' Create a title in open dialog box to specify what file to open 

WasCancled = Application.FileDialog(msoFileDialogOpen).Show ' Show the selection 

If WasCancled <> 0 Then 

PreviousFile = Application.FileDialog(msoFileDialogOpen).SelectedItems(1) ' PreviousFile now has the address of the file 

Else 

Exit Sub 

End If 


'Allow user to select current version of dBase 

Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = False 'Allow only one fiel selection 

'Application.FileDialog(msoFileDialogOpen).InitialFileName = "C:\Users\bkrukowski\Desktop\Paving DataBase" 'Point to the file folder 

Application.FileDialog(msoFileDialogOpen).Title = "SELECT THE NEWER VERSION FOR COMPARISON:" ' Create a title in open dialog box to specify what file to open 

WasCancled = Application.FileDialog(msoFileDialogOpen).Show ' Show the selection 

If WasCancled <> 0 Then 

CurrentFile = Application.FileDialog(msoFileDialogOpen).SelectedItems(1) ' CerrentFile now has the address of the file 

Else 

Exit Sub 

End If 

Application.ScreenUpdating = False 


'Open the previous version 

Set PreviousWB = Workbooks.Open(PreviousFile) 

'Determine the Size of Array needed 

OldRC = PreviousWB.Sheets("Export_Output").UsedRange.Rows.Count 
OldCC = PreviousWB.Sheets("Export_Output").UsedRange.Columns.Count 

PreviousWB.Worksheets("Export_Output").Range("A1").Activate 


ReDim PreviousRecord(OldRC, OldCC) 

' Fill the array 
For i = 1 To OldRC 

    For j = 1 To OldCC 

     PreviousRecord(i, j) = ActiveCell.Value 

     ActiveCell.Offset(0, 1).Activate 

     If j = OldCC Then 

     ActiveCell.Offset(1, -j).Activate 


     End If 


     Next j 

Next i 


'Open the current version 
Set CurrentWB = Workbooks.Open(CurrentFile) 


'Determine the Size of Array needed 

NewRC = CurrentWB.Sheets("Export_Output").UsedRange.Rows.Count 
NewCC = CurrentWB.Sheets("Export_Output").UsedRange.Columns.Count 

CurrentWB.Worksheets("Export_Output").Range("A1").Activate 


ReDim CurrentRecord(NewRC, NewCC) 

'Fill the Array 

For i = 1 To NewRC 

    For j = 1 To NewCC 

     PreviousRecord(i, j) = ActiveCell.Value 

     ActiveCell.Offset(0, 1).Activate 

     If j = NewCC Then 

     ActiveCell.Offset(1, -j).Activate 


     End If 


     Next j 

Next i 

'Ensure array dimentions are same 

If Not OldRC = NewRC Then 

    If NewRC > OldRC Then 

     ReDim Preserve PreviousRecord(NewRC, NewCC) 

     MaxRC = NewRC 

    Else 

     ReDim Preserve CurrentRecord(OldRC, OldCC) 

     MaxRC = OldRC 

    End If 

    Else 

     MaxRC = NewRC 
End If 


    MaxCC = NewCC 

RecordChange = 0 
l = 1 
'Begin comparing Data - If any item on a Row is diffrent from the previous copy the entrie row into new array 

For i = 1 To MaxRC 
    For j = 1 To MaxCC 

     If Not PreviousRecord(i, j) = CurrentRecord(i, j) Then 

      RecordChange = RecordChange + 1 

      ReDim Preserve ChangedRecord(RecordChange, MaxCC) 

      For k = 1 To MaxCC 

       ChangedRecord(l, k) = PreviousRecord(i, k) 
       ChangedRecord(l + 1, k) = CurrentRecord(i, k) 
       l = l + 2 

       Next k 
      End If 

      Next j 
      Next i 


Workbooks("CompareThis").Sheets("Sheet1").Activate 
Range("A1").Activate 

For i = 1 To RecordChange 

    For j = 1 To MaxCC 

     ActiveCell.Value = ChangedRecord(i, j) 
     ActiveCell.Offset(1, j).Activate 
    Next j 
    Next i 


Application.ScreenUpdating = True 





End Sub 

は、あなたが提供することができます任意の助けてくれてありがとう下回る比較するコードがある。また、あなたの要求 であなたに私が働いているファイルを送信することができます。

Answer 1

このコードにはいくつかのインデックスエラーがあります。最初の一つはここにある：あなたがOldRCとOldCCに基づいてPreviousRecordのサイズを設定しているが、あなたのループカウンタがNewRCとNewCCに基づいています

OldRC = PreviousWB.Sheets("Export_Output").UsedRange.Rows.Count 
OldCC = PreviousWB.Sheets("Export_Output").UsedRange.Columns.Count 
'... 
ReDim PreviousRecord(OldRC, OldCC) 
'... 

NewRC = CurrentWB.Sheets("Export_Output").UsedRange.Rows.Count 
NewCC = CurrentWB.Sheets("Export_Output").UsedRange.Columns.Count 
'... 
ReDim CurrentRecord(NewRC, NewCC) 

For i = 1 To NewRC 
    For j = 1 To NewCC 
     PreviousRecord(i, j) = ActiveCell.Value 

。

2番目はここにあります。アレイの最後ののは、Preserveキーワードで変更できます。理由については、this answerを参照してください。

If NewRC > OldRC Then 
    ReDim Preserve PreviousRecord(NewRC, NewCC) 
    MaxRC = NewRC 
Else 
    ReDim Preserve CurrentRecord(OldRC, OldCC) 
    MaxRC = OldRC 
End If 

あなたのコードは、それが十分に行った場合、あなたはかなりここに上記と同じエラーを確認してください。このセクションでは

For i = 1 To MaxRC 
    For j = 1 To MaxCC 
     If Not PreviousRecord(i, j) = CurrentRecord(i, j) Then 
      RecordChange = RecordChange + 1 
      ReDim Preserve ChangedRecord(RecordChange, MaxCC) 

を、あなたはオーバーランニングからlを防ぐために何もしませんバインドされた配列 - それはあなたが持っているどのように多くの不一致に完全に基づいています。

For k = 1 To MaxCC 
    ChangedRecord(l, k) = PreviousRecord(i, k) 
    ChangedRecord(l + 1, k) = CurrentRecord(i, k) 
    l = l + 2 
Next k