通过数组求和合并

Question

我在使用工作表数组（动态创建）的总和合并数据的代码的最后阶段遇到了困难。

代码返回错误1004：Range类的Consolidate方法失败

可能，我将数组条目设置为不受支持的值（例如，R1C1 引用样式是否必要）？请帮忙。

附注我可能只能用一个周期来填充数组，我稍后会尝试解决这个问题。

感谢之前为类似请求做出贡献的人：

Create Excel Consolidated Worksheet with multiple sources in VBA

adding values to variable array VBA

代码如下：

Sub Consolidate_ALL_Click_2()

Dim ws As Worksheet
Dim wArr, siArr As Variant
ReDim siArr(0 To 0)

'--- Run through all sheets in workbook
For Each ws In Worksheets 
  For Each wArr In Array("A", "B", "C", "D")
'--- Check if worksheet name is in matching the list
    If ws.Name = wArr Then
       ReDim Preserve siArr(UBound(siArr) + 1)
'--- Write address to array
       siArr(UBound(siArr)) = ws.Range("A10:C300").Address(ReferenceStyle:=XlReferenceStyle.xlA1, external:=True)
    End If
  Next wArr
Next ws

'--- Consolidate, using pre-defined array of Ranges        
Worksheets("SUMMARY").Range("A10").Consolidate Sources:=Array(siArr), _
Function:=xlSum, TopRow:=False, LeftColumn:=False, CreateLinks:=False

End Sub

Answer 1

您创建siArr 的方式确保siArr(0) will always be empty. Hence theConsolidate` 方法将在空项目上失败。

编辑：看看另一个问题，你确实需要使用HELP 中所述的R1C1 参考样式用于该主题。

如果你打算使用ReDim Preserve方法，那么试试：

'--- Run through all sheets in workbook
For Each ws In Worksheets
  For Each wArr In Array("A", "B", "C", "D")
'--- Check if worksheet name is in matching the list
    If ws.Name = wArr Then
        If Not IsEmpty(siArr(UBound(siArr))) Then _
       ReDim Preserve siArr(UBound(siArr) + 1)
'--- Write address to array
       siArr(UBound(siArr)) = ws.Range("A10:C300").Address(ReferenceStyle:=XlReferenceStyle.xlR1C1, external:=True)
    End If
  Next wArr
Next ws

我通常使用 Dictionary 或 Collection 对象来收集未知大小的对象/变量的列表；然后在完成后重新调整我的数组一次，完全避免ReDim Preserve。您引用的方法将在数组末尾留下一个空元素。您在此处的方法在数组的开头留下了一个空元素。两者都可以通过使用 Dictionary 或 Collection 对象来避免

所以你可以改用：

Dim ws As Worksheet
Dim wArr, siArr As Variant
Dim cWS As Collection

Set cWS = New Collection
'--- Run through all sheets in workbook
For Each ws In Worksheets
  For Each wArr In Array("A", "B", "C", "D")
'--- Check if worksheet name is in matching the list
    If ws.Name = wArr Then
'--- Add address to collection
       cWS.Add ws.Range("A10:C300").Address(ReferenceStyle:=XlReferenceStyle.xlR1C1, external:=True)
    End If
  Next wArr
Next ws

'--- write addresses to array
Dim I As Long
ReDim siArr(0 To cWS.Count - 1)
For Each wArr In cWS
    siArr(I) = wArr
    I = I + 1
Next wArr