Question

我有一张包含大量工作表和数据的电子表格，每行的第一个单元格总是一个日期。我已经制作了一个控制表（Control CUSTOM），其中用户在单元格B3和C3中键入两个日期，然后宏将搜索工作簿中的所有工作表以查找具有这些日期的第一个单元格值的行，然后复制并粘贴行到摘要表（数据自定义）。

然而它并没有按预期工作。宏设法找到正确的行，并复制它们，但它总是粘贴到同一行，因此覆盖自己。它还将它们粘贴到错误的工作表（Control CUSTOM）。

到目前为止，我的代码看起来像这样：

Sub DataSearch()
    Dim lngLastRow As Long, lngRow As Long
    Dim strColumn As String
    Dim WS_Count As Integer
    Dim I As Integer
    Dim NextRow As Variant
    Dim Date1 As Variant
    Dim Date2 As Variant


    Date1 = Sheets("Control CUSTOM").Range("B3")
    Date2 = Sheets("Control CUSTOM").Range("C3")


' Set correct row for paste, always the next empty row



' Set WS_Count equal to the number of worksheets in the active workbook.
WS_Count = ActiveWorkbook.Worksheets.Count

' Begin the loop.
For I = 1 To WS_Count

    strColumn = "A"
    With ActiveWorkbook.Worksheets(I)
        lngLastRow = .Cells(.Rows.Count, strColumn).End(xlUp).Row
        For lngRow = 2 To lngLastRow
        Set NextRow = Range("A" & Sheets("Data CUSTOM").UsedRange.Rows.Count + 1)
        If IsDate(.Cells(lngRow, strColumn).Value) And .Cells(lngRow, strColumn).Value >= Date1     And .Cells(lngRow, strColumn).Value <= Date2 Then
            .Rows(lngRow).Copy
            NextRow.PasteSpecial Paste:=xlValues, Transpose:=False
        Application.CutCopyMode = False


        End If
        Next lngRow
    End With
    Next I
End Sub

希望你们能帮助我。我有一些VBA的经验，但所有这些多个循环，这可能需要我的头脑。

Answer 1

如果您使用NextRow范围变量解决这两个问题，那么您的代码就可以了。

对于性能，您可能需要考虑自动过滤行并在块中进行复制，而不是逐行测试。

您也可能希望从宏中排除两个控制表，以便进行良好的编码操作。

Dim NextRow As Variant
到
Dim NextRow As Range

并改变
NextRow.PasteSpecial Paste:=xlValues, Transpose:=False
到
Set NextRow = Sheets("Data Custom").Range("A" & Sheets("Data CUSTOM").UsedRange.Rows.Count + 1)

Answer 2

正如brettdj所提到的，为了解决这个问题，你应该添加

Sheets("Data Custom").

到

Set NextRow = Range("A" & Sheets("Data CUSTOM").UsedRange.Rows.Count + 1)

所以它写着：

Set NextRow = Sheets("Data Custom").Range("A" & Sheets("Data CUSTOM").UsedRange.Rows.Count + 1)

通过添加Sheets("Data Custom").，您告诉宏该范围不在当前工作表上（具有固有的假设）。

另外，我建议进行一些额外的调整：

最佳实践/潜在问题

使用ThisWorkbook代替ActiveWorkbook以确保您没有意外激活其他工作簿
尽量不要使用.UsedRange属性......永远。要么在你去的时候增加一个计数器，要么做一些类似你之前用lngLastRow = .Cells(.Rows.Count, strColumn).End(xlUp).Row做的事情。这是因为Excel根据格式和最大范围等内容定义了.UsedRange。因此，如果您在一个范围内有一堆值，然后清除了最后一行中的值，它仍将被视为已使用范围的一部分。
我建议将Dim NextRow As Variant更改为Dim NextRow As Range，因为NextRow始终是Range对象，并且不会发生变化。（由brettdj提供）
您可能还想从循环中排除两个控制表，这样您就不会在整个过程中对它们进行评估。这可能导致潜在的问题（由brettdj提供）

表现

对于性能，您可能需要考虑对行进行自动过滤并在块中进行复制，而不是逐行测试。（由brettdj提供）
将以下代码添加到方法的开头（获取日期值后）：
```
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
```
在潜艇结束之前：
```
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
```
这告诉Excel停止显示它对工作簿所做的更改并停止更新/计算任何公式，直到它完成运行宏之后。这将是一个巨大的性能提升。

使用正确的第一个单元格复制和粘贴行的宏

2 个答案:

最佳实践/潜在问题

表现