Question

我试图比较来自两个不同工作簿的工作表，但似乎无法做到这一点。我已多次读过使用数组效率低下但每次尝试建议的解决方案都无处可去。

以下问题正在发生运行时错误9下标超出范围

当我调试时它与填充数组有关，但它不应该超出范围i从1到（在这种情况下为1487）但在1486上出错，所以我仍然在范围内。

我想跳过这个错误，所以我可以看看是否有任何其他问题所以在顶部我有错误goto 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 = 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

您根据OldRC和OldCC设置了PreviousRecord的大小，但您的循环计数器基于NewRC和NewCC。

第二个就在这里。只能使用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

比较两个工作簿的问题

1 个答案: