Как найти следующий доступный столбец и применить к нему формулу

Question

Я пытаюсь изменить назначенный мне столбец "J" на переменную (следующий свободный столбец в строке 5), поскольку иногда используется J. Затем примените формулу к этому столбцу и скопируйте ее, вставив после столбца A. Я знаю, что мне нужно установить значение для последнего столбца, но я не уверен, как собрать все это вместе для моей формулы. Формула обычно работает хорошо, пока данные не введены в столбец J или K, а затем вставляются поверх него.

Range("J5").Select
ActiveCell.FormulaR1C1 = "=RIGHT(RC[-2], 6)"
Selection.AutoFill Destination:=Range("J5:J" & Range("E" & Rows.Count).End(xlUp).Row)
Range(Selection, Selection.End(xlDown)).Select


Columns("B:B").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

Range("A5").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.TextToColumns Destination:=Range("A5"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 3), Array(2, 3), Array(3, 3)), TrailingMinusNumbers:=True

Range("B5").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.NumberFormat = "dd/mm/yyyy;@"
Selection.TextToColumns Destination:=Range("B5"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
:=Array(1, 8), TrailingMinusNumbers:=True

Columns("B:B").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

Range("M5").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy

Range("B5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd, SkipBlanks _
:=False, Transpose:=False

End Sub

Answer 1

Вы можете сделать это, начиная с Range("I5") и используя Resize и Offset, чтобы вставить формулу в диапазон без использования AutoFill.

Приведенный ниже код является однострочным. Примечание: вы вычитаете 4 и 8 для учета строк и столбцов из strtCel

ActiveSheet. _
Range("I5").Resize(ActiveSheet.Range("E" & Rows.Count).End(xlUp).Row - 4, 1). _
Offset(, ActiveSheet.Cells(5, Columns.Count).End(xlToLeft).Column - 8). _
FormulaR1C1 = "=RIGHT(RC8, 6)"

Вы также можете использовать переменные

Dim ws As Worksheet, lRow As Long, eCol As Long, strtCel As Range

Set ws = ThisWorkbook.Sheets("Sheet1") 'Change worksheet name as needed
Set strtCel = ws.Range("I5")

lRow = ws.Range("E" & ws.Rows.Count).End(xlUp).Row
eCol = ws.Cells(5, ws.Columns.Count).End(xlToLeft).Column

    With strtCel.Resize(lRow - 4, 1).Offset(, eCol - 8)
        .FormulaR1C1 = "=RIGHT(RC8, 6)"
        .Value = .Value
    End With