1

谁能帮我修改这个循环来复制和粘贴？

仅Range("S" & Y).Select 当Range("F" & Y). 我想重复这个直到Range("F" & Y). 我现在在行上有数据，Range("F" & Y) 那么它不应该粘贴Range("S" & Y)。当其中有数据时Range("F" & Y)，每三行显示一次。有时数据中可能会有 10 行的间隙，直到下一个数据序列每三行返回一次。

错误：它不会在该数据集的末尾停止，即使在没有数据的情况下它也会粘贴Range("F" & Y) 任何人都可以帮忙吗？

我的代码

Dim lastRow As Long
Range("S16:Y16").Select
Selection.Copy
For Y = 19 To 2000 Step 3

    If Range("F" & Y).Value = lastRow Then Exit For
    Range("S" & Y).Select
    ActiveSheet.Paste
    lastRow = ActiveSheet.Range("B" & Rows.Count).End(xlUp).Row

Next Y
Application.ScreenUpdating = True
MsgBox lastRow
4

2 回答 2

1

A few pointers:

  1. First thing is it doesn't stop at the end when the lastRow is greater than 2000 and your if statement isn't checking for the current row number just the value in it. Also there is a great chance you skip this last row because you are jumping by 3 rows at a time. I suggest you use the following if statement instead:

    If Range("F" & Y).row > lastRow Then Exit For

  2. For your lastrow variable I suggest the following to be more accurate:

    lastrow = activesheet.cells.find("*", range("A1"), , , xlbyrows, xlprevious).row

  3. Also, you're pasting data in every row without checking for a blank value and I would check for a blank cell using this:

    if len(Application.WorksheetFunction.Clean(trim(range("F" & Y).value))) > 0 then
于 2013-04-11T10:24:59.547 回答
0

也许您可以使用 S 到 Y 列中的工作表公式来执行此操作，如下所示：

=IF($F:$F<>"",S:S,"")

将该公式从 S 列复制到 Y 列，然后复制到 2000。

要检查 ROW 是否是每三行，使用 ROW() 函数获取行号，并使用 MOD 查看它是否可以被 3 整除？

对于 VBA，试试这个：

Dim lastRow As Long
lastRow = ActiveSheet.Range("B" & Rows.Count).End(xlUp).Row

Range("S16:Y16").Copy
For Y = lastRow to 19 Step -3
' check column F and Row=Y for contents
if vba.len(vba.trim(range("F" & Y).value))>0 then  
    ' paste into column S
    Range("S" & Y).PasteSpecial xlPasteAll
end if 
Next 
Application.ScreenUpdating = True
MsgBox lastRow

现在它将从 lastRow 运行 BACKWARDS 到 19

您的代码正在根据最后一行的编号检查单元格 Range("F" & Y) 或 Cells(y,6) 的值

于 2013-04-10T10:15:08.853 回答