Excel VBA - 将ArrayList嵌套至Excel工作表

Question

Excel VBA - 将ArrayList嵌套至Excel工作表

excelvbaarraylist

3

寻找更为合适的方式。虽然我有一个可行的解决方案，但它似乎应该有一个内置或更优雅的方法。

我正在比较来自不同工作簿的两个工作表，在当前工作簿的一张工作表中记录差异。每当发现差异时，我就会生成一行输出数据。由于我不知道将找到的差异总数，因此输出数据的行会附加到ArrayList中。

我有一个可用的代码，但是它的有效方法是：

将一行创建为ArrayList。
将该行转换为数组。
将该行添加到用于输出的ArrayList中
将输出ArrayList两次转置并转换为数组
将数组输出到工作表。

尽管使用ArrayLists有诸多好处，但似乎应该有直接输出2D“ArrayList of ArrayLists”或类似内容的方法。

以下是当前的代码：

Sub findUnmatchingCells()

    Dim oWB_v1 As Workbook, oWB_v2 As Workbook, oRange_v1 As Range, oRange_v2 As Range
    
    On Error GoTo endofsub
    
    With Me
    
        .Cells.Clear
        .Cells(1, 1) = "Row"
        .Cells(1, 2) = "Column"
        .Cells(1, 3) = "v1"
        .Cells(1, 4) = "v2"
        
    End With
    Dim missing_items As Object
    Dim output_row(), output(), missing_row As Object
    
    Set oWB_v1 = Workbooks("foo.xls")
    Set oWB_v2 = Workbooks("bar.xls")

    Set oRange_v1 = oWB_v1.Sheets(1).Range("A1:AD102")
    Set oRange_v2 = oWB_v2.Sheets(1).Range("A1:AD102")
    
    Set missing_items = CreateObject("System.Collections.ArrayList")
    
    For rRow = 1 To oRange_v1.Rows.Count
        For cCol = 1 To oRange_v1.Columns.Count
            
            If oRange_v1.Cells(rRow, cCol) <> oRange_v2.Cells(rRow, cCol) Then
                
                Set missing_row = CreateObject("System.Collections.ArrayList")
                
                missing_row.Add rRow
                missing_row.Add cCol
                missing_row.Add oRange_v1.Cells(rRow, cCol).Value2
                missing_row.Add oRange_v2.Cells(rRow, cCol).Value2
                
                output_row = missing_row.toarray
                
                missing_items.Add output_row
                
            End If
        
        Next cCol
    Next rRow
    
    output = Application.WorksheetFunction.Transpose(Application.WorksheetFunction.Transpose(missing_items.toarray))
    
    'my own output routine
    If Not outputArrayToRange(output, Me.Range("A2")) Then Stop
    
    Exit Sub
    
endofsub:
    Debug.Print rRow, cCol, missing_items.Count, missing_row.Count, Error
    Stop

End Sub

- Michael James

实际读取是跨越 1) 行 -> 数组列表; 2) 数组列表 -> 数组; 3) 数组添加到数组列表吗？如果是的话，我认为这比您当前的措辞更清晰易懂。 - QHarr

是的，然后对最终的ArrayList进行双重转置 -> 数组 -> 工作表。 - Michael James

1个回答

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- QHarr · Answer 1

似乎在使用ArrayList时多了很多额外的工作，而您并没有从中获得任何有用的东西。正如您所知道的不匹配计数不能超过起始元素的数量，最后列数将为4，您可以只使用单个数组完成所有这些工作。预先设置数组大小，在循环中填充它。

简化示例：

由于您正在使用Me，因此此代码将在“Sheet1”中。

如果您想要ReDim到实际不匹配的数量以避免覆盖某些内容，那么情况会变得更加复杂，但通常明智的做法是计划开发以避免这种风险。您需要双重转置才能够将行重新调整为列，然后再重新调整为行。

根据您提到的范围，我认为Transpose限制不会成为问题，但在其他情况下，这是一个需要通过额外循环解决的问题。

高效的方法是始终使用数组。将两个范围读入数组中，循环一个并与另一个进行比较，将更改写入预定大小的数组，将数组写入工作表。

如果这只是关于ArrayLists中是否有更好的功能，那么没有。你所做的是简短有效的，但比必要的开销更大。

Option Explicit

Public Sub findUnmatchingCells()

    Dim oWB As ThisWorkbook, oRange_v1 As Range, oRange_v2 As Range

    With Me
    
        .Cells.Clear
        .Cells(1, 1) = "Row"
        .Cells(1, 2) = "Column"
        .Cells(1, 3) = "v1"
        .Cells(1, 4) = "v2"
        
    End With
    
    Dim rRow As Long, cCol As Long
    
    Set oWB = ThisWorkbook

    Set oRange_v1 = oWB.Worksheets("Sheet2").Range("A1:D3") 'would be faster to read this into array and later loop that
    Set oRange_v2 = oWB.Worksheets("Sheet3").Range("A1:D3") 'would be faster to read this into array and later loop that
    
    Dim totalElements As Long, output()
    
    totalElements = oRange_v1.Rows.Count * oRange_v1.Rows.Count
    
    ReDim output(1 To totalElements, 1 To 4)

    For rRow = 1 To oRange_v1.Rows.Count 'would be faster to loop arrays than sheet
        For cCol = 1 To oRange_v1.Columns.Count
            If oRange_v1.Cells(rRow, cCol) <> oRange_v2.Cells(rRow, cCol) Then
                output(rRow, 1) = rRow
                output(rRow, 2) = cCol
                output(rRow, 3) = oRange_v1.Cells(rRow, cCol).Value2
                output(rRow, 4) = oRange_v2.Cells(rRow, cCol).Value2
            End If
        Next cCol
    Next rRow
        
    oWB.Worksheets("Sheet1").Cells(2, 1).Resize(UBound(output, 1), UBound(output, 2)) = output

End Sub

其他想法：

如果添加引用不是问题，您可以拥有早期绑定：

来源：https://www.snb-vba.eu/VBA_Arraylist_en.html

ThisWorkbook.VBProject.References.AddFromFile "C:\WINDOWS\Microsoft.NET\Framework\v4.0.30319\mscorlib.tlb"

或者

ThisWorkbook.VBProject.References.AddFromguid "{BED7F4EA-1A96-11D2-8F08-00A0C9A6186D}", 2, 4

您正在浪费已经创建的对象，因为在循环中不断重新创建您的 missing_row ArrayList。在循环之前只需创建一次，并在下一次绕回循环之前调用 .Clear 方法即可。