excel - 跨多个工作表运行 VBA 代码问题

Question

我目前正在使用此代码检查我的工作表并检查范围 O15:O300 以查看是否有任何与当前日期匹配的单元格。如果有，则将整行复制到工作表“今日行动”，然后将站点编号(位于单元格 C3 中)复制到“今日行动”中的 AA 列。

我使用以下代码，该代码适用于一张特定工作表的此任务:

Sub rangecheck()

Application.ScreenUpdating = False

For Each cell In Range("O15:O300")

    If cell.Value = Date Then
        matchRow = cell.Row
        Rows(matchRow & ":" & matchRow).Select
        Selection.Copy
        Sheets("Today's Actions").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        ActiveSheet.Range("C3").Copy
        Sheets("Today's Actions").Range("AA" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
    End If
Next

Application.ScreenUpdating = True


End Sub

但是，我需要针对多张工作表执行此代码。所以我使用下面的代码在所有工作表上运行它:

Sub rangecheck_Set()

Dim ws As Worksheet

Dim starting_ws As Worksheet

Set starting_ws = ActiveSheet 

Application.ScreenUpdating = False

For Each ws In ThisWorkbook.Worksheets

    ws.Activate

    Call rangecheck
    
Next

starting_ws.Activate 'activate the worksheet that was originally active ("Today's Actions")

Application.ScreenUpdating = True

End Sub

我遇到的这个问题是，它似乎可以正常工作，但只要有很多日期与 O15:O300 范围内的今天日期匹配，它就会重复一些行，最多或略超过 300 行(所以作为例如，如果有 15 行“应该”被带回“今天的行动”标签，它会将它们带回来，但随后会有几行随机复制到第 300 行左右)。

我知道这可能是由于范围下降到 300，但我什至编辑了范围以转到“最后一行”，但它仍然带来了同样的问题。有什么想法吗？这几天我一直在努力解决这个问题。任何帮助表示赞赏

Answer 1

不要使用对工作表和范围的隐式引用。这很可能是您的问题的原因。

此外，您无需选择和复制 - 不可预见错误的另一个来源。

您出错的另一个原因可能是您没有从复制程序中排除“今日行动”表。

我重写了复制数据的子程序:

Sub copyTodaysRows(wsSource As Worksheet, wsTarget As Worksheet)

If wsSource is wsTarget then Exit Sub   'don't run this for the target sheet

Dim c As Range, wsTargetNewRow As Long

For Each c In wsSource.Range("O15:O300")

    If c.Value = Date Then
        With wsTarget
            wsTargetNewRow = .Range("A" & .Rows.Count).End(xlUp).Row + 1
            c.EntireRow.Copy Destination:=.Range("A" & wsTargetNewRow) 
            .Range("AA" & wsTargetNewRow).Value = wsSource.Range("C3").Value
        End With
    End If
Next



End Sub

它将源工作表和目标工作表作为输入参数。

你会在你的“外部”例程中这样调用它:

Sub rangecheck_Set()


Application.ScreenUpdating = False

Dim wsSource as worksheet

Dim wsTarget as worksheet
Set wsTarget = Thisworkbook.Worksheets("Today's Actions")

For Each wsSource In ThisWorkbook.Worksheets
   copyTodaysRows wsSource, wsTarget
Next
Application.ScreenUpdating = True

End Sub