Question

有人可以帮我修改这个循环来复制和粘贴吗？

仅当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

Answer 1

一些指示：

首先，当lastRow大于2000并且你的if语句没有检查当前行号时，它不会停止。还有一个很有可能你跳过最后一行，因为你一次跳3行。我建议您改用以下if语句：
```
If Range("F" & Y).row > lastRow Then Exit For
```

对于您的lastrow变量，我建议以下内容更准确：

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

此外，您在每行中粘贴数据而不检查空白值，我会使用此检查空白单元格：
```
if len(Application.WorksheetFunction.Clean(trim(range("F" & Y).value))) > 0 then
```

Answer 2

也许您可以使用列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

您的代码正在检查单元格范围（“F”和Y）或单元格（y，6）与最后一行数字的值

循环只粘贴有数据的行

2 个答案: