按数组中的总和进行合并

Question

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

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

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

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

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

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

向变量数组 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 the合并"方法在空项目上失败。

编辑：看看另一个问题，您确实需要使用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。引用的方法将在数组末尾保留一个空元素。 您的方法在此处在数组的开头留下一个空元素。通过使用字典或集合对象可以避免这两种情况

因此，您可以改用：

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