VBA – не копируйте и вставляйте данные на основе информации
Я создал код, основанный на «добавлении строки» в столбце A, вставке строки ниже. Например, если в строке A10 есть «добавить строку», то строка вставляется в A11.
На следующем основании я хочу скопировать и вставить специальное значение для столбцов E:H во вновь созданную строку.
Код, который я создал, вы можете найти ниже. К сожалению, это работает только для одной позиции - то есть, если у меня есть «добавить строку» в строке A10, A13, A20, она копирует и вставляет только для A11, а остальные остаются неизменными.
Точнее, в A14 должны быть формулы из A13, а в A21 — из A20. Не могли бы вы мне подсказать, что я сделал не так?
Sub PasteFormulasBelowAddLine()
Dim ws As Worksheet
Dim lastRow As Long, i As Long
Dim addLineRows() As Long
Dim addLineCount As Long
' Set the worksheet
Set ws = ThisWorkbook.Sheets("Input Sheet_wo_Main Sum Lin (3)")
' Find the last row in column A
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).row
' Initialize variables
addLineCount = 0
' Loop through column A to find "add line" and store row numbers in array
For i = 1 To lastRow
If ws.Cells(i, "A").Value = "add line" Then
addLineCount = addLineCount + 1
ReDim Preserve addLineRows(1 To addLineCount)
addLineRows(addLineCount) = i
End If
Next i
' Paste formulas in rows below "add line"
For i = 1 To addLineCount
' Check if the row below "add line" exists and is not empty
If addLineRows(i) < lastRow Then
' Copy formulas from the row containing "add line"
ws.Range(ws.Cells(addLineRows(i), "E"), ws.Cells(addLineRows(i), "H")).Copy
' Paste formulas into the row below
ws.Range(ws.Cells(addLineRows(i) + 1, "E"), ws.Cells(addLineRows(i) + 1, "H")).PasteSpecial Paste:=xlPasteFormulas
Application.CutCopyMode = False ' Clear clipboard
End If
Next i
End Sub
Пример: Начинаем Excel
Результат
A21 from A20I have "add line" in row A10, A13, A20 В ячейке А20 нет формул. Какова ожидаемая формула в ячейке A21? Я предполагаю, что формулы во вставленной строке взяты из строки ниже. Это правильно?
Убедитесь, что перед add line нет пробелов в начале или в конце. Чтобы устранить LTRIM, можно попробовать RTRIM или INSTR.
Да, я хочу вставить формулы, но в них должна быть обновлена ссылка на ячейки. Вставляем строку ниже «добавить строку». Строки, в которых стоит «добавить строку», содержат формулы, которые необходимо скопировать и вставить.
Ответы 1
- Вставка строки сдвигает все строки ниже. Циклирование должно происходить в обратном порядке.
- Назначение формул более эффективно, чем копирование/вставка.
Sub PasteFormulasBelowAddLine()
Dim ws As Worksheet
Dim lastRow As Long, i As Long
Dim addLineRows() As Long
Dim addLineCount As Long
' Set the worksheet
Set ws = ThisWorkbook.Sheets("Input Sheet_wo_Main Sum Lin (3)")
' Find the last row in column A
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).row
' Initialize variables
addLineCount = 0
' Loop through column A to find "add line" and store row numbers in array
For i = 1 To lastRow
If ws.Cells(i, "A").Value = "add line" Then
addLineCount = addLineCount + 1
ReDim Preserve addLineRows(1 To addLineCount)
addLineRows(addLineCount) = i
Debug.Print i ' debug code
End If
Next i
' Paste formulas in rows below "add line"
For i = addLineCount To 1 Step -1
' Check if the row below "add line" exists and is not empty
If addLineRows(i) <= lastRow Then
ws.Rows(addLineRows(i) + 1).Insert
' Copy formulas from the row containing "add line"
With ws.Cells(addLineRows(i), 3)
.Offset(1).Value = .Value ' Update Col C
End With
' Update formulas on Col E:H
With ws.Range(ws.Cells(addLineRows(i), "E"), ws.Cells(addLineRows(i), "H"))
.Resize(2).Formula = .Formula
End With
End If
Next i
End Sub
В коде ОП нет вставок строк, которые не могли бы быть причиной.
Это не работает. Тем не менее, он добавляет только формулы в «верхний» комментарий «Добавить строку». Дальнейшие «добавить строку» игнорируются и формулы не включаются.
Я обновил код. Запустите его и проверьте вывод в окне VBE Immedaite. Недостающие строки add line могут быть не перехвачены.
Если я использую макрос, который вставляет строки, то он работает по принципу «добавить строку». Это не работает для формул копирования и вставки. Если я удалю «добавить строку» сверху, он распознает следующую «добавить строку»...
Что такое вывод в окне VBA Immediate?
Выходные данные — 10 и 13, поэтому строки «добавить строки» (перед вставкой строк).
Почему 20 нет в выводе? Пожалуйста, отредактируйте свое сообщение, чтобы поделиться примерами данных и ожидаемыми результатами. Как создать минимальный воспроизводимый пример
Данные поделились. 20 нет в выходных данных, поскольку сейчас я тестирую 10 и 13.
Он вставляет строку ниже 10 и правильно включает формулы. Он игнорирует «добавить строку в строке 13...».
13-й ряд — последний, пожалуйста, попробуйте If addLineRows(i) <= lastRow Then
copy and paste special for columns E:HВы имеете в виду формулы пасты?A14 should have formulas from A14второеA14— опечатка?