Question

我在代码的最后阶段一直很困难，该代码用于通过汇总工作表（动态创建）中的数据来合并数据。

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

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

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

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

Create Excel Consolidated Worksheet with multiple sources in 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 Consolidate`方法对空项目失败。

编辑：实际上，您确实需要使用R1C1中针对该主题的HELP参考风格。

如果要使用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

通过汇总汇总来自数组

1 个答案: