Как скопировать формулу в другие столбцы - PullRequest
0 голосов
/ 27 апреля 2020

У меня есть таблица, которую я создал с помощью предыдущего макроса.

С помощью другого вопроса мне удалось найти «Все остальные» в столбце B и вставить формулу в соседний столбец.

PrintScreen: enter image description here

Теперь я хотел бы скопировать формулу из неизвестной активной ячейки и вставить ее в соседние столбцы: D, E, G, H, I, J и L. Offset – 0 Rows.

В настоящее время у меня есть:

Sub AllOther()

Dim ws As Worksheet
Dim aOther As Range
Dim DataLastRow As Long

Set ws = ActiveSheet

DataLastRow = ws.Cells(ws.Rows.Count, 3).End(xlUp).Row

    Set aOther = ws.Range("B:B").Find("All Other", LookIn:=xlValues, lookat:=xlWhole)

    If Not aOther is Nothing Then
        aOther.Offset(0, 1).Formula = "=SUM(" & aOther.Offset(3, 1).Address & ":" & ws.Cells(DataLastRow,3).Address & ")"
    Else
        MsgBox """All Other"" not found in column."
    End If

'Copy/Paste into other Columns
End Sub

1 Ответ

0 голосов
/ 27 апреля 2020

Q1 / Что такое " Неизвестная активная ячейка" , на которую вы ссылаетесь?

Q2 / Что вы хотите сделать сумма в формуле = SUM ("& aOther.Offset (3, 1) .Address &": "& ws.Cells (DataLastRow, 3) .Address &") "?

Начало диапазона aOther.Offset (3, 1). Адрес на 3 строки ниже aДругой и конец диапазона находится где угодно.

В любом случае это будет проще, если в формуле вы не смешали смещение aOther со смещением ws .

3 / , если бы разрешить вам l oop, как в следующем коде

Sub AllOther()
    Dim ws As Worksheet
    Dim aOther As Long
    Dim aOtherRow As Integer ' row

    Dim arr As Variant
    arr = Array(3, 4, 5, 7, 8, 9, 11) ' columns to sum

    Set ws = ActiveSheet

    Set aOther = ws.Range("B:B").Find("All Other", LookIn:=xlValues, lookat:=xlWhole).Row

    If Not aOther Is Nothing Then
        aOtherRow = aOther.Row
        For Each i In arr
            ws.Cells(aOtherRow, i).Formula = "=SUM(" & ws.Cells(FirstRow, i).Address & ":" & ws.Cells(LastRow, i) & ")"
        Next i
    Else
        MsgBox """All Other"" not found in column."
    End If
End Sub

, в котором FirstRow и LastRow зависят от ответа на Q2

------------------- Редактировать после ответов Cari Day ------------------------

Sub AllOther()
    Dim ws As Worksheet
    Dim aOther As Range

    Dim aOtherRow As Long
    Dim DataFirstRow As Long
    Dim DataLastRow As Long
    Dim col as integer

    Dim ColumnsArray As Variant
    ColumnsArray = Array(3, 4, 5, 7, 8, 9, 11) ' columns to sum


    Set ws = ActiveSheet

    Set aOther = ws.Range("B:B").Find("All Other", LookIn:=xlValues, lookat:=xlWhole)

    If Not aOther Is Nothing Then
        aOtherRow = aOther.Row
        DataFirstRow = aOtherRow + 1
        DataLastRow = ws.Cells(ws.Rows.Count, 3).End(xlUp).Row
        For Each col In ColumnsArray
            ws.Cells(aOtherRow, col).Formula = "=SUM(" & ws.Cells(DataFirstRow, col).Address & ":" & ws.Cells(DataLastRow, col).Address & ")"
        Next col
    Else
        MsgBox """All Other"" not found in column."
    End If
End sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...