Строка формулы Excel VBA не обновляет строку

Question

Итак, мой код - вставить строку, скопировать ее формат из предыдущей строки, а затем вставить формулы, которые я задал, в другую строку.Допустим, я вставил новую строку, строку 11, формула должна скопировать форматы строки 10 и вставить формулы из строки 44 (которую я обозначил как строку формулы).

Теперь все формулы будут ссылаться на строку 10, а не на строку 11. Я не уверен, почему это так.

Вот мой код:

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 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
Next I

End Sub

Это работало нормально, пока я не добавил новый лист, и расширилось с For i = 1 To 3 до For i = 1 to 4.

Есть идеи, почему он вдруг перестал работать?

Answer 1

проблема заключается в тех относительных ссылках на другой лист, которые не обновляются никакими сдвигами строк, происходящими на листе, где они используются

, в то время как они обновляются, если вы сдвинули строки влист, на который они ссылаются

, поэтому вам нужно немного поиграть с относительными / абсолютными ссылками, чтобы имитировать смещение некоторых строк ссылочного листа, но без этого!

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

Sub Convert(rng As Range, toReferenceType As XlReferenceType)
    Dim cell As Range

    For Each cell In rng.SpecialCells(XlCellType.xlCellTypeFormulas) ' loop thorugh passed range relevant cells (i.e. those containing formulas)
        If InStr(cell.Formula, "!") > 0 Then cell.Formula = Application.ConvertFormula(cell.Formula, xlA1, xlA1, toReferenceType) ' if current cell has an explicit sheet reference, then convert its formula to the passed reference type
    Next
End Sub

и использует его в своем коде

For i = 1 To 1
    With ThisWorkbook.Sheets(i)
        .Rows(blank_row_to_use).Copy .Rows(blank_row_to_use + 1) ' copy formulas "template" row one "helper" row below
        Convert .Rows(blank_row_to_use + 1), xlAbsolute ' convert "helper" row formulas with some explicit sheet reference to absolute type so they don't get updated by any subsequent row shift
        .Rows(blank_row_to_use + 1).Copy .Rows(blank_row_to_use) ' copy "helper" row converted formulas and paste them back to formula "template" row -> now you have a formula with an absolute row reference one below its own row
        .Rows(blank_row_to_use + 1).ClearContents ' clear "helper" row

        .Rows(row_to_insert).Insert Shift:=xlDown, opyOrigin:=xlFormatFromLeftOrAbove ' insert new row -> formulas "template" row references don't get updated and now you have a formula with an absolute row reference to its own row 
        Convert .Rows(blank_row_to_use + 1), xlRelative ' convert formulas "template" row formulas with some explicit sheet reference to relative type so they do get updated by any subsequent row shift

        .Rows(row_to_insert).EntireRow.Formula = .Rows(blank_row_to_use + 1).EntireRow.Formula ' copy formulas "template" row formulas row to the new row and have them updated
    End With
Next

Обратите также внимание, что

.Rows(row_to_insert).EntireRow.Formula = .Rows(blank_row_to_use + 1).EntireRow.Formula 

лучше, чем любой Copy и последующий PasteSpecial подход, поскольку он не использует буфер обмена

Answer 2

Попробуйте гораздо более короткую и чистую версию того, чего вы пытаетесь достичь.

Примечание : старайтесь избегать использования Select, Selection и ActiveSheet и используйтеполностью квалифицированные Sheet объекты.

измененный код

'loop through position sheets and insert blank rows
For i = 1 To 4
    With ThisWorkbook.Sheets(i)
        .Rows(row_to_insert).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        .Rows(blank_row_to_use + 1).EntireRow.Copy
        .Rows(row_to_insert).EntireRow.PasteSpecial xlPasteFormulas
    End With
Next i