摘要 Sheet 更新源 Sheets

Question

我想做一个总结 sheet，如果更改，也会更改它从中提取的源 sheet。到目前为止，我的代码汇总了摘要 sheet 上摘要 sheet 上的所有 sheet 激活事件。我正在尝试在停用事件上更新我的所有其他 sheet，但它似乎不起作用。这是我正在使用的代码：

Private Sub Worksheet_Deactivate()

Application.ScreenUpdating = False

Dim tabs As Variant
tabs = Array("BELD", "RMLD", "Pascoag", "Devens", "WBMLP", "Rowely", "AMP", "First Energy", "Dynegy", "APN", "MISC")

For j = 1 To UBound(tabs)

    Sheets(tabs(j)).Select

    Dim rng1 As Range
    Dim Stri As String
        For i = 3 To ActiveSheet.UsedRange.Cells(ActiveSheet.UsedRange.Cells.Count).Row
            Stri = ActiveSheet.Cells(i, "A")
            Set rng1 = Worksheets("Summary").Range("A:A").Find(Stri, , xlValues, xlWhole)
            If Not rng1 Is Nothing Then
                Sheets("Summary").Range(rng1.Address).EntireRow.Copy
                ActiveSheet.Range("A" & i).EntireRow.Select
                Selection.Insert Shift:=xlLeft
                ActiveSheet.Range("A" & i + 1).EntireRow.Select
                Selection.Delete Shift:=xlUp
            Else
                MsgBox strSearch & " not found"
            End If
        Next

        ActiveSheet.Range("A" & 1).Select

Next

Application.ScreenUpdating = True

End Sub

我是 vba 的新手，这是我在 Whosebug 上的第一个 post，所以如果我遗漏了什么，请告诉我。

Answer 1

当您以这种方式分配变体数组时，您将得到一个从零开始的数组。您需要从 j = 0 开始。由于您自己的代码当前是，它永远不会访问 BELD 工作表。

Dim tabs As Variant
tabs = Array("BELD", "RMLD", "Pascoag", "Devens", "WBMLP", "Rowely", "AMP", "First Energy", "Dynegy", "APN", "MISC")

For j = 0 To UBound(tabs)
   ....

一种更通用的方法是使用 For j = LBound(tabs) To UBound(tabs)，这与您的数组是基于 1 还是基于 0 无关，因为您让每个数组通过 LBound function and UBound function.[=18= 描述自己的属性]

更全面地重写您的例程将包括摆脱 .Select 和 .Activate 方法，并在其位置使用直接工作表和单元格引用。

Private Sub Worksheet_Deactivate()
    Dim rng1 As Range
    Dim Stri As String, lr As Long, j As Long, i As Long
    Dim tabs As Variant

    On Error GoTo bm_Safe_exit
    Application.ScreenUpdating = False
    Application.EnableEvents = False

    tabs = Array("BELD", "RMLD", "Pascoag", "Devens", "WBMLP", "Rowely", _
                 "AMP", "First Energy", "Dynegy", "APN", "MISC")

    For j = LBound(tabs) To UBound(tabs)
        With Sheets(tabs(j))
            lr = .Cells.Find(Chr(42), After:=.Cells(1, 1), SearchDirection:=xlPrevious).Row
            For i = 3 To lr
                Stri = .Cells(i, "A").Value
                If CBool(Len(Stri)) Then
                    On Error Resume Next
                    With Me.Range("A:A")
                        Set rng1 = .Find(What:=Stri, After:=.Cells(.Rows.Count), LookIn:=xlValues, LookAt:=xlWhole)
                    End With
                    On Error GoTo bm_Safe_exit
                    If Not rng1 Is Nothing Then
                        'clearing then copy/paste may be better than inserting, pasting and ultimately deleting old row
                        .Rows(i).Clear
                        rng1.EntireRow.Copy _
                            Destination:=.Range("A" & i)
                    Else
                        'maybe copy the data from the sheet back to the summary sheet if this occurs
                        MsgBox Stri & " on " & .Name & " not found on Summary"
                    End If
                End If
            Next
        End With
    Next

bm_Safe_exit:
    Application.ScreenUpdating = True
    Application.EnableEvents = True

End Sub

由于这是在摘要工作表的代码表中，因此 Me 的使用可应用于摘要工作表对象。将 rng1 设置为查找返回的范围后，不再需要描述它来自的工作表，因为它带有 Range .Parent property。

请参阅 How to avoid using Select in Excel VBA macros 了解更多摆脱依赖的方法 select 并激活以实现您的目标。

摘要 Sheet 更新源 Sheets

Summary Sheet That Updates Source Sheets

vba

excel

aggregate

summary