更新源表的摘要表

时间:2015-07-16 18:55:47

标签: excel vba excel-vba aggregate summary

我想制作一个摘要表,如果更改,则会更改它所提供的源表。到目前为止,我所拥有的代码汇总了摘要表激活事件摘要表上的所有表格。我试图让我的所有其他工作表更新停用事件但它似乎没有工作。这是我正在使用的代码:

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上的第一篇文章,所以如果我错过了什么,请告诉我。

1 个答案:

答案 0 :(得分:0)

以这种方式分配变量数组时,最终会得到一个从零开始的数组。您需要从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 functionUBound 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设置为find返回的范围后,不再需要描述它来自的Range .Parent property随附的工作表。

有关远离依赖选择和激活以实现目标的更多方法,请参阅How to avoid using Select in Excel VBA macros