时间戳

首页 > 解决方案 > 将执行时定义的一系列单元格复制到数组

arrays - 将执行时定义的一系列单元格复制到数组

问题描述

我正在尝试从两个工作簿的一系列行中复制一系列单元格。此信息用于按 ID 比较两个工作簿行的内容。

我尝试的第一个解决方案涉及逐个单元格的“二进制”比较。这适用于几行的工作表：

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

我想将两个工作簿中每一行的内容存储在一个数组中以进行比较，因为我相信这是一个更快的解决方案。

在定义范围以进行比较后，将单元格复制到数组中时遇到以下错误：

子索引超出区间（错误 9）

这会产生错误：

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

标签： arraysexcelvbacopyrange

解决方案

完整修订：

范围数组赋值在这些行中生成一个二维数组：

aWorkbookBInfo = rngWorkbookBToCompare
aWorkbookAInfo = rngWorkbookAToCompare

无论您在代码开头如何定义和标注它们，都会发生这种情况。aWorkbookBInfo(a, b)因为它们是一个二维数组，所以它们必须按a行和b列来寻址。

与范围不同，可以引用任何范围中的第一个单元格，您必须在尝试引用数组项之前完全寻址数组。所以，虽然rngWorkbookBToCompare(j).Value有效，aWorkbookBInfo(j).Value但没有。此外，值不一定是 Excel 放入数组中的任何对象的属性。如果您想要 column 的第一个单元格j，请尝试添加行并保留对Value属性的引用，如下所示：aWorkbookBInfo(1, j)。

推荐阅读