☰

如何设置宏，使其每次执行以下操作

tag-icon • tag-icon microsoft-excel macros
如何设置宏，使其每次执行以下操作

我是这里的一名新手，我被困住了，接下来几天我必须重复做一项任务。非常感谢您的帮助。提前致谢。

设置：

  • 有2張。
  • Sheet1 上有一堆数据。
  • 在Sheet2上，有一个与Sheet1中格式相同的数据表，但是该表是空的。

。

期望的行动：

  1. 转到 Sheet1 中数据表的第一行。
  2. 如果该行最右列的值为“1”，则复制整行。如果不是，则转到下一行并再次检查。重复此操作，直到复制了内容。
  3. 转到 Sheet2 中数据表的第一个空行。粘贴刚刚复制的值。
  4. 返回 1。但从上次中断的地方开始。重复整个过程，直到 Sheet1 中所有符合上述条件的数据都已复制到 Sheet2。

进步：

我通过模仿上述操作尝试得到的录制的宏脚本。

工作表1

工作表2

Sub Macro7()                 ' ' Macro7 Macro '

Range("E11:R11").Select
Selection.Copy Sheets("v4 r2").Select
Range("E11").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range("E12").Select Sheets("v4 q2").Select
Range("E12:R12").Select Application.CutCopyMode = False
Selection.Copy Sheets("v4 r2").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range("E13").Select
End Sub

答案1

试试这个 - 我试图坚持你录制的宏，但记住我们想要避免使用.Select/.Activate，并使用一个或两个变量来跟踪下一个空行。

Sub t()
Dim lastCol&, lastRow&, emptyRow&, i&
Dim mainWS As Worksheet, copyToWS As Worksheet

' Create two variables to hold the sheets
Set mainWS = Sheets("v4 q2")
Set copyToWS = Sheets("v4 r2")

emptyRow = 1

'Now, let's find the last column in the mainWS, and last row
lastCol = mainWS.Cells(1, mainWS.Columns.Count).End(xlToLeft).Column
lastRow = mainWS.Cells(mainWS.Rows.Count, 1).End(xlUp).Row ' assuming your column A (1) has the most data

' Now, loop through your last Column, looking for `1`
For i = 1 To lastRow
    If mainWS.Cells(i, lastCol).Value = "1" Then
       ' Since you only want the VALUES, we can just set the two ranges equal to eachother
       ' instead of using .Copy
       copyToWS.Range(copyToWS.Rows(emptyRow), copyToWS.Rows(emptyRow)).Value = mainWS.Range(mainWS.Rows(i), mainWS.Rows(i)).Value
    emptyRow = emptyRow + 1
    End If
Next i

End Sub

另外，请注意，由于您只需要值，我们可以将范围设置为相等，而不是复制/粘贴（这会使用剪贴板，并且可能需要更多时间）。要做到这一点，只需Range[destination].Value = Range[the range to copy].Value。

相关内容