Как зациклить формулу в разных ячейках в Excel VBA?

Question

У меня есть фрагмент кода, в котором я суммирую ячейку «K6» на каждом листе рабочей книги, добавляя основную, называемую «Данные». Однако он жестко запрограммирован, и я хотел бы иметь возможность его зациклить. Либо это, либо установление формулы, чем ее расширение. Я думаю, что будет легче понять, о чем я говорю, посмотрев на код

Это то, что у меня уже есть

`Sub SumSheets()

Dim ws As Worksheet

For Each ws In ThisWorkbook.Worksheets

If ws.Name <> "Data" Then

SumTotal = SumTotal + ws.Range("K6").Value
SumTotal2 = SumTotal + ws.Range("K7").Value
SumTotal3 = SumTotal + ws.Range("K8").Value
SumTotal4 = SumTotal + ws.Range("K9").Value

End If

Next

Sheets("Data").Range("A6").FormulaR1C1 = SumTotal
Sheets("Data").Range("A7").FormulaR1C1 = SumTotal2
Sheets("Data").Range("A8").FormulaR1C1 = SumTotal3
Sheets("Data").Range("A9").FormulaR1C1 = SumTotal4

End Sub'

Этот фрагмент кода работает так, как я хочу, но было бы намного проще, если бы я мог найти способ его зациклить. Или, может быть, установить SumTotal как функцию и расширить его, как в обычном Excel.

Sub SumSheets()

Dim ws As Worksheet
Dim i As Integer
Dim j As Integer

For Each ws In ThisWorkbook.Worksheets

If ws.Name <> "Data" Then

SumTotal = SumTotal + ws.Range("K6").Value
SumTotal2 = SumTotal + ws.Range("K7").Value
SumTotal3 = SumTotal + ws.Range("K8").Value
SumTotal4 = SumTotal + ws.Range("K9").Value

For i = SumTotal To SumTotal4
For j= 6 To 10

Cells(j,1).Value = i

Next j
Next i

End If

Next

End Sub'

Результат с циклом For, который я пробовал, состоит в том, что он помещает значение SumTotal4 только в ячейки с 6 по 10. Я предполагаю, что это потому, что я недостаточно хорошо определился.

Answer 1

Как UDF:

Function SumAll(addr As String)
    Application.Volatile
    Dim ws As Worksheet, tot
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> "Data" Then tot = tot + ws.Range(addr).Value
    Next ws
    SumAll = tot
End Function

Затем (например) в A6 вы можете ввести:

=SumAll("K6")

или лучше:

Function SumAll(c As Range)
    Application.Volatile
    Dim ws As Worksheet, tot
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> "Data" Then tot = tot + ws.Range(c.Address(False, False)).Value
    Next ws
    SumAll = tot
End Function

тогда можете нас (например)

=SumAll(K6)

и он будет корректироваться при перетаскивании

Answer 2

Вы также можете иметь его как подпрограмму, которая объединяет строку, и вы можете использовать свойство .Formula, чтобы назначить его диапазону. Excel автоматически обновит формулу.

Например, если вы хотите, чтобы А1 в «Тесте» отображал сумму К6 во всех тех листах, имя которых не является данными, А2 отображал все те, у кого есть К7 и т. Д. Сработало бы следующее:

Sub test()
Dim str1 As String, str2 As String
Dim ws As Worksheet, i As Integer, j As Integer


j = 0

'As data pertains to one spreadsheets name

i = ThisWorkbook.Worksheets.Count - 1

For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "Data" Then
    j = j + 1
    If i - j = 0 Then
        str1 = "'" & ws.Name & "'!K6 "
    Else
        str1 = "'" & ws.Name & "'!K6, "
    End If
    str2 = str2 & str1
End If
Next ws

ThisWorkbook.Worksheets("Test").Range("A1:A7").Formula = "=sum(" & str2 & ")"


End Sub

Дополнительным бонусом является то, что вы можете отслеживать свою формулу через свой рабочий лист, если это представляет интерес.

Для вашего запроса ниже измените функцию if с помощью str1 на:

    If i - j = 0 Then
        str1 = "abs('" & ws.Name & "'!E6)/('" & ws.Name & "'!K6) "
    Else
        str1 = "abs('" & ws.Name & "'!E6)/('" & ws.Name & "'!K6), "
    End If

Последняя строка также должна измениться:

ThisWorkbook.Worksheets("Data").Range("A1:A7").Formula = "=average(" & str2 & ")"