Скопируйте формулу вниз по столбцу Dynami c в vba (без заголовка) - PullRequest
0 голосов
/ 10 июля 2020

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

Я попытался скопировать формулу вниз по столбцу после этого:

Sub Sum_three_months()


Set Three_months = Range("A1:ZZ10000").Find("x")
    Three_months.Select
    FormularCell = ActiveCell.Offset(1, 0).Select
    Selection.Resize(Selection.Rows.Count, _
    Selection.Columns.Count).Select

    ActiveCell.FormulaR1C1 = "=SUM(R[-0]C[-4]:R[-0]C[-2])"
    
Sum_six_months ' starts the next update, but has the same format as above
End Sub

I пробовал Autofil и FillDown, но с автозаполнением я получаю сообщение об ошибке с диапазоном / выбранной ячейкой, а с Filldown он просто копирует заголовок.

Кто-нибудь может мне с этим помочь?

1 Ответ

0 голосов
/ 10 июля 2020

Попробуйте этот код, пожалуйста:

Sub Sum_three_months()
  Dim sh As Worksheet, Three_months As Range, rngLast As Range, x As String, lastCol As Long
 
  Set sh = ActiveSheet 'use here your sheet
  lastCol = sh.Cells(1, Columns.Count).End(xlToLeft).Column
  x = "x" 'use here your search string...
  Set Three_months = sh.Range(sh.Cells(1, 1), sh.Cells(1, lastCol)).Find(x)
  If Not Three_months Is Nothing Then
      Set rngLast = sh.Cells(sh.Cells(Rows.count, Three_months.Offset(0, -4).Column).End(xlUp).row, Three_months.Column)
    
      sh.Range(Three_months.Offset(1, 0), rngLast).formula = _
                   "=SUM(" & sh.Range(Three_months.Offset(1, -4), Three_months.Offset(1, -2)).address(0, 0) & ")"
  Else
     MsgBox "Not a ""x"" range could be found...": Exit Sub
  End If
    
 Sum_six_months ' starts the next update, but has the same format as above
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...