Question

我正在处理的工作表是一份任务管理表，其中包含已打开，待处理和已完成项目的列表。我创建了一个下拉菜单，一个人可以更改任务的状态，但我希望自动化该过程，以便完成的任务将行切换到新工作表到完成的任务表的末尾，原始表格将向上移动一行。另外，我想要包含两个消息框（一个询问任务完成的日期，另一个提示是否有任何与任务相关的注释），在将数据行复制到新工作表后，将添加两个两个相邻单元格中的新数据点。

理论上，宏将是：如果列F =＆＃34;已完成＆＃34;中的单元格，则从该行的C：H突出显示（这是我遇到的第一个问题，将选择偏移到剪切），剪切数据并将其粘贴到新工作表的第一个空行（到B列）。之后，提示完成日期的两个消息框和任务的注释将弹出，并且在那里输入的值将分别粘贴到新工作表的F和G列中。

我从一个基本的if和then语句开始，但是由于偏移的编码（不断得到1004错误）而停止选择要剪切的数据。

Answer 1

所以这是一个快速而肮脏，强力执行以下操作的方法：

- 通过sheet1上的列f搜索 -if'找到'完成'，将内容剪切/复制到sheet2上的第二行（插入它们使之前的项目向下移动并使用第二行，因为第1行通常是标题），然后在sheet1上删除'complete'行 - 在此过程中输入消息框以获取完成日期和任何注释，并将该数据分别放入sheet2列f和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)

如果然后在两张带有消息框

1 个答案: