检查单元格值，匹配时复制

我有一个不断增长的名单。

如果某个单元格值大于10，则应将整行复制到某个工作表中。 如果值为10或更小，则应检查下一行，直到达到包含数据的最后一行。

这是我目前的macros。 它像以前一样将行复制到相同的位置。 我需要他们列出没有自由空间。

Sub Copy() Dim s1 As Worksheet, s2 As Worksheet Dim N As Long, i As Long, j As Long Set s1 = Sheets("Hours") Set s2 = Sheets("Check") N = s1.Cells(Rows.Count, "R").End(xlUp).Row j = 1 For i = 1 To N If s1.Cells(i, "R").Value > "10" Then s1.Cells(i, "R").EntireRow.Copy s2.Cells(j, 1) j = j + 1 End If Next i End Sub 

Answer 1

我试图不离开你原来的代码（即使使用AutoFilter方法是相当诱人的）

我认为你的错误是由于不完全符合你寻找N （最后一行）的方式。 你使用了N = s1.Cells(Rows.Count, "R").End(xlUp).Row ，如果ActiveSheet是另一个表单，那么N = s1.Cells(Rows.Count, "R").End(xlUp).Row会得到一个不同的值。 我刚刚添加了工作表引用N = s1.Cells(s1.Rows.Count, "R").End(xlUp).Row

我添加了另一个“安全”的标准，如果你有一个“R”列中的文本，我已经修改你的If条件为“If IsNumeric（s1.Range（”R“＆i））和s1.Range（”R “＆i）.Value> 10 Then`

码

 Sub Copy() Dim s1 As Worksheet, s2 As Worksheet Dim N As Long, i As Long, j As Long Set s1 = Sheets("Hours") Set s2 = Sheets("Check") N = s1.Cells(s1.Rows.Count, "R").End(xlUp).Row j = 1 For i = 1 To N If IsNumeric(s1.Range("R" & i)) And s1.Range("R" & i).Value > 10 Then s1.Cells(i, "R").EntireRow.Copy s2.Cells(j, 1) j = j + 1 End If Next i End Sub 

Answer 2

完成当前脚本后，可以执行后处理，删除空行（将范围“C50”更改为列/行的最大范围以检查空白）：

  dim r As Range, rows As Long, i As Long Set r = Sheets("Check").Range("A1:C5000") rows = r.rows.Count For i = rows To 1 Step (-1) If WorksheetFunction.CountA(r.rows(i)) = 0 Then r.rows(i).Delete Next