Изменение строки в формуле VBA - PullRequest
0 голосов
/ 29 января 2019

У меня есть рабочая книга, в которую я время от времени добавляю строки.Когда я добавляю строку, я копирую строку, полную формул, которые ссылаются на другие листы в книге (т. Е. = Datasheet! A12).При вставке формул формулы, которые не ссылаются на другой лист, обновляются до новой тонкой строки, а формулы, которые ссылаются на другие листы, - нет (т. Е. = Таблица данных! A12 должна стать = таблица данных! A13).Поэтому мое решение состоит в том, чтобы перебрать новую строку и найти формулы с "!"и измените номер строки.Я открыт для лучших решений, кстати.В настоящее время мой код ничего не обновляет.Утверждение «если» всегда ложно по какой-то причине.Вот мой код:

Dim i As Integer
Dim r As Range
Dim cell As Range
Set r = Rows(row_to_insert).Cells

'loop through position sheets and insert blank rows
For i = 1 To 4
    Sheets(i).Select
    Rows(row_to_insert).EntireRow.Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Next i

'loop through position sheets and copy/paste formulas into new rows
For i = 1 To 4
    Sheets(i).Select
    Rows(blank_row_to_use + 1).EntireRow.Select
    Selection.Copy
    Rows(row_to_insert).EntireRow.Select
    ActiveSheet.Paste
    r = Rows(row_to_insert)
    For Each cell In r ' loop thorugh passed range relevant cells (i.e. those containing formulas)
        If InStr(cell.Formula, "!") > 0 Then cell = Replace(cell, (row_to_insert - 1), (row_to_insert)) ' if current cell has an explicit sheet reference, then convert its formula to the passed reference type
    Next
Next i

row_to_insert - это приглашение, позволяющее выбрать строку для добавления, а blank_row_to_use - это строка с формулами, которые я копирую.

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

Dim i As Integer
'loop through position sheets and insert blank rows
For i = 1 To 4
    Sheets(i).Select
    Rows(row_to_insert).EntireRow.Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Next i

'loop through position sheets and copy/paste formulas into new rows
For i = 1 To 4
    Sheets(i).Select
    Rows(blank_row_to_use + 1).EntireRow.Select
    Selection.Copy
    Rows(row_to_insert).EntireRow.Select
    ActiveSheet.Paste
    Dim r As Range
    Dim cell As Range
    Set r = Rows(row_to_insert).Cells.SpecialCells(xlCellTypeFormulas)
    For Each cell In r ' loop thorugh passed range relevant cells (i.e. those containing formulas)
        If InStr(cell.Formula, "!") > 0 Then cell = Replace(cell.Formula, (row_to_insert - 1), (row_to_insert)) ' if current cell has an explicit sheet reference, then convert its formula to the passed reference type
    Next
Next i
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...