Сумма кросс-листа и быстродействие

Question

Я пытаюсь сложить много листов (11-12) с мастером под названием «Всего - Ресурсы». У меня есть несколько диапазонов, я не хочу суммировать ячейку за ячейкой, но не могу найти Решение добавить несколько диапазонов, которые должны быть добавлены в sht.Range? Я также испытываю огромные проблемы со скоростью при попытке добавить различные диапазоны, как это ... Есть ли лучший, более простой способ сделать то же самое, как описано в коде.

• Используйте больше диапазонов

• Скорость исполнения

  For Each Sht In ThisWorkbook.Worksheets
      If Sht.Name Like "*- Resources" Then
          For Each cell In Sht.Range("G11:G46")'Add another range "G22:G46","F46.."?
              Cast = cell.Address
              Sheets("Total - Resources").Range(Cast) = Sheets("Total - Resources").Range(Cast) + cell.Value
          Next cell
      End If
  Next Sht
  

Answer 1

Я бы предложил следующее:

1. Определите ваши адреса SumAddresses, которые должны суммироваться.
2. Обработайте эти адреса по областям.
   Адрес A1:C4,A7:C10 состоит из 2 областей: A1:C4 и A7:C10
3. Работа с массивами. Это означает чтение данных в каждой области в массив. Затем выполните вычисление суммы с помощью массива и в конце запишите этот массив в область назначения на рабочем листе Total. Работать с массивами гораздо быстрее, чем с использованием диапазонов.

Таким образом, вы получите что-то вроде:

Option Explicit

Public Sub SumResourceSheets()
    Dim SumAddresses As String
    SumAddresses = "A1:C4,A7:C10,D5" 'note this is limited to 255 characters!

    Dim ResultRange As Range
    Set ResultRange = ThisWorkbook.Worksheets("Total - Resources").Range(SumAddresses)
    ResultRange.ClearContents 'make result range epmty

    ReDim SumAreas(1 To ResultRange.Areas.Count) As Variant
    Dim iArea As Long
    For iArea = LBound(SumAreas) To UBound(SumAreas)
        SumAreas(iArea) = ResultRange.Areas(iArea).Cells.Value 'read area into array

        Dim ws As Worksheet
        For Each ws In ThisWorkbook.Worksheets
            If ws.Name Like "*- Resources" And ws.Name <> "Total - Resources" Then 'exclude Total - Resources
                If ws.Range(ResultRange.Areas(iArea).Address).Cells.CountLarge = 1 Then
                    'handle single cell areas…
                    SumAreas(iArea) = SumAreas(iArea) + ws.Range(ResultRange.Areas(iArea).Address).Value
                Else
                    'this is for multi cell areas …

                    'read data area into array
                    Dim DataArea() As Variant
                    DataArea = ws.Range(ResultRange.Areas(iArea).Address).Value

                    'sum data into sum array
                    Dim iRow As Long
                    For iRow = LBound(DataArea, 1) To UBound(DataArea, 1)
                        Dim iCol As Long
                        For iCol = LBound(DataArea, 2) To UBound(DataArea, 2)
                            If IsNumeric(DataArea(iRow, iCol)) Then
                                SumAreas(iArea)(iRow, iCol) = SumAreas(iArea)(iRow, iCol) + DataArea(iRow, iCol)
                            Else
                                MsgBox "The cell '" & ResultRange.Areas(iArea).Cells(iRow, iCol).Address & "' in worksheet '" & ws.Name & "' does not contain a number!", vbCritical
                                Exit Sub
                            End If
                        Next iCol
                    Next iRow
                End If
            End If
        Next ws

        ResultRange.Areas(iArea).Cells.Value = SumAreas(iArea) 'write area into cell
    Next iArea
End Sub