Консолидация по сумме из массива - PullRequest
Новая
       40

Консолидация по сумме из массива

1 голос
/ 08 января 2020

У меня возникли трудности с последней стадией кода для консолидации данных по сумме из массива рабочих таблиц (динамически создаваемых).

Код возвращает ошибку 1004: Консолидация метода Range сбой класса

Возможно, я устанавливаю записи массива в неподдерживаемые значения (например, необходим ли ссылочный стиль R1C1)? Пожалуйста, помогите.

PS Я, вероятно, могу go с одним циклом только для заполнения массива, я постараюсь выяснить это позже.

Спасибо ребятам, ранее внесшим свой вклад в похожие запросы:

Создание сводной рабочей таблицы Excel с несколькими источниками в VBA

добавление значений в массив переменных 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

1 Ответ

1 голос
/ 08 января 2020

Способ, которым вы создаете siArr, гарантирует, что метод siArr(0) will always be empty. Hence the Consolidate` завершится ошибкой для пустого элемента.

Редактировать: Если вы посмотрите на другую проблему, вы делаете, действительно, для этого топика нужно использовать справочный стиль R1C1, как указано в HELP, c.

Если вы собираетесь использовать метод 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
...