Как скопировать формулу по горизонтали в таблице с помощью Excel VBA? - PullRequest
Новая
       16

Как скопировать формулу по горизонтали в таблице с помощью Excel VBA?

0 голосов
/ 26 сентября 2018

Итак, у меня есть данные, которые выглядят так:

tables in excel

Две верхние таблицы усредняют вместе определенные данные из третьей таблицы.

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

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

 Sub What()

Dim m As Integer
Dim n As Integer
Dim TableName As String
Dim i As Integer
Dim x As Integer
Dim LastRow As Integer

For i = 1 to 12
TableName = "Table" & i

    With ActiveSheet.ListObjects(TableName)

        .ListColumns.Add

    n = .ListColumns.Count
    m = n - 1

             'this is filling in the first row, with the column number (needed for formulas in the real data)
        .DataBodyRange(1, n).Value = n
        .DataBodyRange(1, n).NumberFormat = "General"

    LastRow = .ListRows.Count

             'this is where I'm trying to copy the formula over to the right
        For x = 2 To LastRow
            .DataBodyRange(x, n) = .DataBodyRange(x, m).Formula
        Next x

    End With

  Next i 

End Sub

Проблема в том, что он копирует формулу прямо, поэтому мой новый столбец F таблицы A1 все еще усредняет значениястолбец E из таблицы A3.

До того, как у меня появился код, я попробовал автозаполнение (например: 

Range("K4").Select
        Selection.AutoFill Destination:=Range("K4:L4"), Type:=xlFillDefault

)

, но мне это не нужнообратитесь к диапазону, мне нужно, чтобы он ссылался на ячейку таблицы, например, ActiveSheet.ListObjects ("Table1"). DataBodyRange (3, 2) .Наивно я попытался передать это для пункта назначения 

ActiveSheet.ListObjects("Table1").ListColumns.Add
        ActiveSheet.ListObjects("Table1").DataBodyRange(1, 2).Select
        Selection.AutoFill Destination:=ActiveSheet.ListObjects("Table1").DataBodyRange(1, 3), Type:=xlFillDefault

, и мне сказали

Ошибка времени выполнения '1004': сбой метода автозаполнения класса Range

Все ресурсы, которые я гуглил, относятся к заполнению формулы вниз по столбцу, но из-за ориентации моих данных она мне нужна для копирования по горизонтали, а не по вертикали, и я ничего не нашел для этого.Может кто-нибудь помочь мне с этим?

Большое спасибо ~

1 Ответ

0 голосов
/ 26 сентября 2018
  • Destination должен включать и начальную ячейку / диапазон и целевую ячейку / диапазон.
  • AutoFill также можно выполнить за один раз вместо токовой петли от 2-го ряда к последнему.
  • Не нужно использовать Select или Selection.

Что-то вроде этого демонстрирует концепцию - при необходимости измените: 

Option Explicit

Sub AutoFillRight()
    Dim myTbl As ListObject: Set myTbl = Sheet1.ListObjects("Table1")
    Dim sourceRng As Range, destRng As Range
    Dim lastRow As Long, lastCol As Long

    With myTbl
        .ListColumns.Add

        lastRow = .ListRows.Count
        lastCol = .ListColumns.Count

        If lastRow > 1 Then
            Set sourceRng = Range(.DataBodyRange(2, lastCol - 1), .DataBodyRange(lastRow, lastCol - 1))
            Set destRng = Range(.DataBodyRange(2, lastCol - 1), .DataBodyRange(lastRow, lastCol))

            sourceRng.AutoFill Destination:=destRng, Type:=xlFillDefault
        End If
    End With
End Sub
...