Если между двумя листами с полем сообщений

Question

Лист, над которым я работаю, представляет собой лист управления задачами со списком открытых, ожидающих и завершенных элементов. Я создал раскрывающееся меню, которое человек может изменить статус задачи, но я хочу автоматизировать процесс, чтобы завершившаяся задача перерезала строку на новый лист до конца заполненной таблицы задач, а оригинал лист сдвинется на один ряд. Кроме того, я хотел включить два окна сообщений (тот, который задает дату завершения задачи, а другую, которая запрашивает, есть ли какие-либо комментарии, связанные с задачей), которые после копирования строки данных на новый лист добавили бы два новые точки данных в двух соседних ячейках.

В теории макрос будет выглядеть следующим образом: если ячейка в столбце F = «Завершено», выделите из C: H этой строки (это первая проблема, с которой я столкнулся со смещением выделения, чтобы разрезать), вырезать данные и вставьте его в первую пустую строку (в колонку B) нового листа. После этого появятся два окна сообщений с указанием даты завершения и примечаний к задаче, и введенные там значения будут вставляться в столбцы F и G нового листа соответственно.

Я начал с базового оператора if и then, но был остановлен кодировкой для смещения (чтобы получить ошибку 1004) выбор данных для вырезания.

Answer 1

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

-Поиск через колонку F на sheet1
-если «Complete» найдено, вырезать/копировать содержимое грести два на sheet2 (вставляя их так, чтобы предыдущие элементы сдвигались вниз и использовали строку два, так как строка 1 обычно является заголовком), а затем удалять строку с «полным» на листе 1
-Получить поле ввода сообщений в этом процессе, чтобы получить дату завершения и любые заметки и поместить эти данные в столбцы таблицы f2 и g соответственно.

Выше было то, что я читаю, чтобы ваш запрос был. В приведенном ниже коде, вероятно, есть некоторые ненужные выборки листа, и вы можете поместить данные в g и h, так как я не уверен, действительно ли вы захотите переписать содержимое столбца f, которое было только что вставлено. Но ниже должно быть близко к тому, что вы хотите.

Dim i As Integer 
Dim DateComplete As Variant 
Dim Notes As Variant 

i = 2 'variable for iterating through sheet1 

While Sheet1.Cells(i, 6).Value <> "" 'do while column f is not empty 
    Sheets("Sheet1").Select 'Make sure sheet 1 is selected 
    If Cells(i, 6).Value = "Complete" Then 
     'Insert new row in sheet2 
     Sheets("Sheet2").Select 
     Rows("2:2").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 

     'copy desired cells from sheet1 
     Sheets("Sheet1").Select 
     Range("C" & i & ":H" & i).Copy 

     'Go back to sheet2 and paste rows into row 2 
     Sheets("Sheet2").Select 
     Range("A2").Select 
     ActiveSheet.Paste 

     'input box for date with syntax for possible task name reference with default date set to today 
     DateComplete = InputBox("Enter Date Complete For task " & Cells(i, 3).Value, "Completion Date", Format(Now(), "yyyy/mm/dd")) 
     Notes = InputBox("Enter Notes", "Notes") 

     'input values from message boxes into f2 and g2 
     Sheets("Sheet2").Select 
     Range("F2").Value = DateComplete 
     Range("G2").Value = Notes 

     'Go to sheet1 and delete row that was just copied from 
     Sheets("Sheet1").Select 
     Rows(i & ":" & i).Delete Shift:=xlUp 
    Else 
     i = i + 1 'i only needs to be iterated if complete is not found 
    End If 
Wend 
response = MsgBox("Done", vbOKOnly) 

Если завершенные записи желательно поместить в первом открытом ряду в sheet2 в противоположность вставляя их на второй линии, то используйте следующий код:

Dim i As Integer 
Dim x as Integer 
Dim DateComplete As Variant 
Dim Notes As Variant 

i = 2 'variable for iterating through sheet1 
x = 1 
'Find first blank row in column a on sheet2 
While Sheet2.Cells(x, 6).Value <> "" 
    x = x + 1 
Wend 
'x is now set to first blank row in sheet2 

While Sheet1.Cells(i, 6).Value <> "" 'do while column f is not empty 
    Sheets("Sheet1").Select 'Make sure sheet 1 is selected 
    If Cells(i, 6).Value = "Complete" Then 
     'copy desired cells from sheet1 
     Sheets("Sheet1").Select 
     Range("C" & i & ":H" & i).Copy 

     'Go back to sheet2 and paste rows into row x 
     Sheets("Sheet2").Select 
     Range("A" & x).Select 
     ActiveSheet.Paste 

     'input box for date with syntax for possible task name reference with default date set to today 
     DateComplete = InputBox("Enter Date Complete For task " & Cells(i, 3).Value, "Completion Date", Format(Now(), "yyyy/mm/dd")) 
     Notes = InputBox("Enter Notes", "Notes") 

     'input values from message boxes into f2 and g2 
     Sheets("Sheet2").Select 
     Range("F" & x).Value = DateComplete 
     Range("G" & x).Value = Notes 

     'Go to sheet1 and delete row that was just copied from 
     Sheets("Sheet1").Select 
     Rows(i & ":" & i).Delete Shift:=xlUp 
     x = x + 1 
    Else 
     i = i + 1 'i only needs to be iterated if complete is not found 
    End If 
Wend 
response = MsgBox("Done", vbOKOnly)