Переместить целую строку на основе столбца A в смещение (-1,4)

Question

В настоящее время у меня есть большой файл Excel, в котором данные не совпадают с соответствующими заголовками.

Чтобы исправить это, мне нужно вырезать и вставлять все строки, где столбец «A» содержит «Запланировано» по одной строке и четырем столбцам справа. У меня есть несколько тысяч строк, которые нужно переместить (с VBA). Я работал над сборкой некоторого кода, но безрезультатно (я имел ограниченное знание VBA).

Ниже приведен снимок данных, с которыми я работаю. Мне нужно, чтобы желтый ряд был перемещен в красную зону. Зеленая строка сверху - пример того, как она выглядит после внесения изменений вручную. Надеюсь, этот код будет прокручивать весь лист, и я получаю данные, соответствующие их уважительным заголовкам.

(строка желтых данных, который должен быть перемещен в 60 столбцов в ширине, кстати, картина показывает только небольшой снимок листа)

Answer 1

Быстрого & грязное, непроверенное решения. Попробуй.

Dim cel as range 
For each cel in Range("A1:A" & Range("A1").end(xldown).row 
    if cel.value = "Planned:" then 
     cel.resize(1,60).cut 
     cel.offset(-1,4).pastespecial xlpasteall 
    end if 
next cel 

Answer 2

Вы можете попробовать этот метод (без VBA)

1. выберите регион назначения (красная область)
2. ударил Ctrl+g затем нажмите кнопку Special

3. выбрать Blank, нажмите Ok

   

4. тип в ссылочной формуле (например, в E3 формула будет =A4) и ударила Ctrl+Enter заполнить все

5. копии вставить весь красный столбец в качестве значения (т.е. удалить формулу)
6. фильтра столбец A для значения Planned: и удалять строки.

Я знаю, что это имеет недостаток, на шаге 6, если ваши данные очень большие, Excel может не удалить отфильтрованные строки правильно

Answer 3

Эту короткую процедура должна заботиться о аберрантных данных импорта при переключении теперь - пустые «запланированные» линии.

Sub fix_planned() 
    Dim rw As Long 
    With Worksheets("Sheet1") 
     For rw = .Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1 
      If LCase(Left(.Cells(rw, 1).Value2, 8)) = "planned:" Then 
       .Range(.Cells(rw, 1), .Cells(rw, Columns.Count).End(xlToLeft)).Copy _ 
        Destination:=.Cells(rw, 1).Offset(-1, 4) 
       .Rows(rw).EntireRow.Delete 
      End If 
     Next rw 
    End With 
End Sub 

Предлагаем Вам устранить источник данных, так что вам не придется повторно восстановить данные 'после-фактум.