Question

我的名单不断增加。

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

这是我目前的宏。它将行复制到与之前相同的位置。我需要它们列出没有可用空间。

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

完成当前脚本后，您可以执行后处理，删除空行（更改范围＆＃34; C50＆＃34;到列/行的最大范围以检查为空）：

  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

Answer 2

我尽量不要偏离原始代码（尽管使用AutoFilter方法非常诱人）

我认为您的错误是由于没有完全符合您查找N的方式（最后一行）;您使用了N = s1.Cells(Rows.Count, "R").End(xlUp).Row，如果ActiveSheet是另一个工作表，那么您将获得Rows.Count的不同值。我刚刚添加了工作表参考N = s1.Cells(s1.Rows.Count, "R").End(xlUp).Row

我添加了另一个“安全”标准，如果您在“R”列中有文字，我已将您的If条件修改为'If IsNumeric（s1.Range（“R”＆amp; i）））和s1.Range（“R”＆amp; i）.Value＆gt; 10然后`

<强>代码

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

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

2 个答案: