Question

Sub CopyRows4()
    Dim rng As Range
    Dim cl As Range
    Dim str As String
    Dim RowEmpCrnt As Long
    Dim RowUpdCrnt As Long
    Dim WshtEmp As Worksheet

    Set WshtEmp = Sheets("Employee Data")
    Set rng = WshtEmp.UsedRange 'the range to search ie the used range
    str1 = "Executive" 'string to look for
    str2 = "Working"

    Sheets("Executive").UsedRange.Value = ""

    RowUpdCrnt = 3

    For Each cl In rng.Columns("E").Rows
        If cl.Text = str1 Then
          RowEmpCrnt = cl.Row
          If WshtEmp.Cells(RowEmpCrnt, "X").Value = str2 Then
            ' If both column "A" and column "E" contain the correct value
            ' copy it to next empty row on sheet 2
            cl.Range("a3:z3").Copy Sheets("executive").Cells(RowUpdCrnt, 1)

            RowUpdCrnt = RowUpdCrnt + 1
          End If
        End If
    Next cl
End Sub

这里我想从列A3开始从Sheets(Employee Data)复制数据，仅用于那些满足条件的列/行。

Answer 1

首先是您的代码存在的一些问题。

第1期

我从未见过以这种方式清除工作表：Sheets("updated").UsedRange.Value = ""

最明显的问题是它不能清除任何格式。我还想象一下，使用大型工作表会很慢。我建议：

With Sheets("updated")
  .Cells.EntireRow.Delete
End With

或

Sheets("updated").Cells.EntireRow.Delete

使用With语句在这种情况下没有太大的区别，但它可以使代码更清晰。我建议你在VBA编辑的帮助

中查找With statement

第2期

For Each cl In rng查看rng中的每个单元格：A1，B1，C1，...，A2，{{1 }}，B2，... ,, C2，A3，B3，...等等。如果C3是rng然后检查所有1300个细胞。

如果值为“是”的单元格分散，那么这将是您的意图。但是，我假设所有值为“是”的单元格都在一列中。我在测试数据中使用了列“E”;您必须使用正确的数据列标识符替换E“。

A1:Z500说我只对“E”栏感兴趣。这给了For Each cl In rng.Columns("E")这不是我想要的。

E1:E500说我对列“E”中的行感兴趣。这样做：For Each cl In rng.Columns("E").Rows，E1，E2，...

第3期

E3

这将为您提供在这种情况下所需的效果，但您需要了解这意味着什么，因为它无法在所有情况下提供您所需的效果。

If cl.Text = str Then给出单元格的Excel值。除了一些例外情况，cl.Value为您提供单元格的显示值。例外情况都与一些比较模糊的水平对齐有关，所以我会忽略它们。

对于字符串，Excel值和显示值将相同。对于格式化的数值，它们可能不相同。因此，如果Excel值123格式化为两位小数，则显示值将为123.00。

第4期

cl.Text

这很聪明但是：

在任何情况下都可能达不到你期望的效果，
可能是某些行被覆盖的原因
它不必要地复杂化。

我不喜欢“复杂”。你或许可以查看这个字符串并快速解释它的作用，但你的能力较差的同伴可能没有。

说实话，我对Sheets("updated").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)不满意，在我看来，这也是“复杂”。它需要深入了解Excel对象模型才能知道它的作用。我只使用它，因为我想尽可能少地改变你的代码。如果这是我的代码，我将避免使用此构造。

rng.Columns("E").Rows，End(xlUp)，End(xlDown)和End(xlToLeft)是键盘的VBA等价物 Ctrl + 向上箭头 ， Ctrl + 向下箭头， Ctrl + 向左箭头和 Ctrl + 右箭头控件。

假设A列底部的单元格为空，End(xlToRight)概念性地将光标向上移动到列的顶部或带有值的第一个单元格。 Cells(Rows.Count, 1).End(xlUp)然后向下移动一行。

当你第一次使用这个命令时，你刚刚清除了工作表，所以这个命令到了列的顶部，然后向下一个，所以第一个输出行是2.也许这就是你想要的但是你偶然得到它不设计。

更重要的是，如果您从工作表“员工数据”中复制的任何行在A列中没有值，则它将被覆盖。这可能是您报告问题的原因。

我已删除此命令。相反，我有一个新变量RowUpdCrnt。（对不起，在这个答案的第一个版本中，我有RowEmpCrnt。）我将RowUpdCrnt初始化为1.如果你想在顶部有一个空行，将其改为2。每次我复制一行时，我都会向RowUpdCrnt添加1。

<强>摘要

我希望以上对你都有意义。询问是否有任何不清楚的地方。

我建议的代码

Offset(1, 0)

响应评论的新部分，在移动行之前，A和X列都需要“是”

我认为此代码符合额外要求：

Sub CopyRows3()
    Dim rng As Range
    Dim cl As Range
    Dim str As String
    Dim RowUpdCrnt As Long

    Set rng = Sheets("Employee Data").UsedRange 'the range to search ie the used range
    str = "Yes" 'string to look for

    Sheets("updated").UsedRange.Value = ""

    RowUpdCrnt = 1

    ' In my test data, the "Yes"s are in column E.  This For-Each only selects column E.
    ' I assume all your "Yes"s are in a single column.  Replace "E" by the appropriate
    ' column letter for your data.
    For Each cl In rng.Columns("E").Rows
        If cl.Text = str Then
             'if the ell contains the correct value copy it to next empty row on sheet 2 &  delete the row
            cl.EntireRow.Copy Sheets("updated").Cells(RowUpdCrnt, 1)
            RowUpdCrnt = RowUpdCrnt + 1
        End If
    Next cl
End Sub

将数据从一个工作表复制到另一个工作表而不删除以前复制的行

1 个答案: