更新源表的汇总表

Question

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

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 很陌生，这是我在 stackoverflow 上的第一篇文章，所以如果我遗漏了什么，请告诉我。

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 和 UBound function 描述其自己的属性。

更全面地重写您的例程将包括摆脱 .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，了解更多摆脱依赖选择和激活来实现目标的方法。