如果然后用消息框在两张纸之间

我正在处理的工作表是一个任务pipe理表,其中包含已打开,待处理和已完成项目的列表。 我已经创build了一个下拉菜单,一个人可以改变任务的状态,但是我想让这个过程自动化,以便一个完成的任务将行切换到一个新的工作表到一个完成的任务表的末尾,表格将上移一行。 另外,我想包括两个消息框(一个询问任务完成的date,另一个提示是否有任何与任务相关的注释),在将该行数据复制到新的表格后,将添加两个新的数据点在两个相邻的单元格中。

理论上,这个macros是:如果F =“Completed”列中的一个单元格,然后从该行的C:H突出显示(这是我遇到的第一个问题,用于偏移要切割的选区),剪切数据并粘贴它进入新工作表的第一个空白行(进入B列)。 之后,提示完成date和任务提示的两个消息框将popup,并且在那里input的值将分别粘贴到新工作表的F和G列中。

我从一个基本的if和then语句开始,但是被偏移的编码(不断收到1004错误)停止了要切割的数据的select。

所以这里是一个快速而肮脏的powershell方法:

– 通过sheet1上的列fsearch
如果find“完成”,则将内容剪切/复制到sheet2上的第二行(插入它们使之前的项目向下移动并使用第二行,因为第一行通常是标题),然后在sheet1上用'complete'删除行
– 在这个过程中有input消息框来获得完成date和任何注释,并把这些数据分别放在sheet2列f和g中。

以上是我正在阅读你的要求。 下面的代码可能有一些不必要的表格select,你可能想把数据放到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) 

如果完成的logging需要放在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)