Copy a range of cells, defined on execution, to an

2019-07-16 07:52发布

问题:

I am trying to copy a range of cells from a range of rows from two workbooks. This information is used to do a comparison of the contents of both workbooks rows by ID.

The first solution I tried involved cell by cell "binary" comparison. This works for worksheets with few rows:

For i = 2 To LastSheetRow
    Set FoundCell = Workbooks(WorkbookA).Sheets(SheetNameFromArray).Range("A:A").Find(What:=Workbooks(WorkbookB).Sheets(SheetNameFromArray).Cells(i, 1).Value)
    If Not FoundCell Is Nothing Then

        aCellValues(0) = 1
        Workbooks(UserWorkbook).Sheets(SheetNameFromArray).Cells(i, LastSheetColumn + 1).Value = FoundCell.Row
        For j = 2 To LastSheetColumn
            Select Case Workbooks(WorkbookB).Sheets(SheetNameFromArray).Cells(i, j).Value
            Case Is = Workbooks(WorkbookA).Sheets(SheetNameFromArray).Cells(FoundCell.Row, j).Value
                aCellValues(j - 1) = 1

            Case Else
                aCellValues(j - 1) = 0
            End Select
        Next j
    Else
    End If
Next i

I would like to store the contents of one row of each of the two workbooks on one array to do the comparison, as I believe it's a faster solution.

After defining the range to do the comparison I encountered the following error when copying the cells into an array:

Subindex out of interval (Error 9)

This generates the error:

Dim aWorkbookBInfo() As Variant, aWorkbookAInfo() As Variant, rngWorkbookBToCompare As Range, rngWorkbookAToCompare As Range
Dim SumToCheck As Integer, FoundCell As Range, aCellValues() As Integer   
ReDim aCellValues(LastSheetColumn - 1)
ReDim aWorkbookBInfo(LastSheetColumn - 1)
ReDim aWorkbookAInfo(LastSheetColumn - 1)
For i = 2 To LastSheetRow
    Set FoundCell = Workbooks(WorkbookA).Sheets(SheetNameFromArray).Range("A:A").Find(What:=Workbooks(WorkbookB).Sheets(SheetNameFromArray).Cells(i, 1).Value)
    If Not FoundCell Is Nothing Then        
        aCellValues(0) = 1
        Workbooks(WorkbookB).Sheets(SheetNameFromArray).Cells(i, LastSheetColumn + 1).Value = FoundCell.Row
        With Workbooks(WorkbookB).Sheets(SheetNameFromArray)
            Set rngWorkbookBToCompare = Range(Cells(i, 2), Cells(i, LastSheetColumn))
        End With
        With Workbooks(WorkbookA).Sheets(SheetNameFromArray)
            Set rngWorkbookAToCompare = Range(Cells(FoundCell.Row, 2), Cells(FoundCell.Row, LastSheetColumn))
        End With
        aWorkbookBInfo = rngWorkbookBToCompare
        aWorkbookAInfo = rngWorkbookAToCompare
        For j = 1 To LastSheetColumn - 1
            If aWorkbookBInfo(j).Value = aWorkbookAInfo(j).Value Then                
                aCellValues(j) = 1                
            Else
                aCellValues(j) = 0
            End If
        Next j
    Else
    End If
Next i

回答1:

Complete Revision:

The range array assignment produces a two-dimensional array in these lines:

aWorkbookBInfo = rngWorkbookBToCompare
aWorkbookAInfo = rngWorkbookAToCompare

This happens regardless of how you defined and dimensioned them at the beginning of your code. Since they are a two-dimensional array, they must be addressed as aWorkbookBInfo(a, b) where a is a row and b is a column.

Unlike Ranges, where it is okay to reference the first cell in any range, you must fully address an array before attempting to reference the array item. So, while rngWorkbookBToCompare(j).Value works, aWorkbookBInfo(j).Value does not. Furthermore, Value is not necessarily a property of whatever object Excel puts in the array. If you want the first cell of column j, try adding the row and leaving off the reference to the Value property as in: aWorkbookBInfo(1, j).