从数组求和合并

Question

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

代码returns错误1004：合并范围class的方法失败

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

P.S。我可能只能用一个循环来填充数组，我稍后会尝试解决这个问题。

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

在 VBA 中创建具有多个来源的 Excel 合并工作表

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 对象来收集未知大小的 objects/variables 列表；然后在完成后只重新调整我的数组一次，完全避免 ReDim Preserve 。您引用的方法将在数组末尾留下一个空元素。您的方法在数组的开头留下一个空元素。两者都可以通过使用字典或集合对象来避免

所以你可以改用：

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

从数组求和合并

Consolidation by Sum from Array

arrays

excel

vba

consolidation