我是这里的一名新手,我被困住了,接下来几天我必须重复做一项任务。非常感谢您的帮助。提前致谢。
设置:
- 有2張。
- Sheet1 上有一堆数据。
- 在Sheet2上,有一个与Sheet1中格式相同的数据表,但是该表是空的。
。
期望的行动:
- 转到 Sheet1 中数据表的第一行。
- 如果该行最右列的值为“1”,则复制整行。如果不是,则转到下一行并再次检查。重复此操作,直到复制了内容。
- 转到 Sheet2 中数据表的第一个空行。粘贴刚刚复制的值。
- 返回 1。但从上次中断的地方开始。重复整个过程,直到 Sheet1 中所有符合上述条件的数据都已复制到 Sheet2。
进步:
我通过模仿上述操作尝试得到的录制的宏脚本。
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
。