无法激活工作表VBA

时间:2015-07-10 02:14:31

标签: excel vba excel-vba

我是编码的新手,我似乎无法解决这个问题。我正在尝试将一些范围从一个工作表复制并粘贴到另一个工作表。执行此操作时,代码尝试激活新工作表时,系统会继续提示您输入错误消息。守则如下。尝试激活"摘要"时发生错误。复制和粘贴范围之前的工作表。

Sub nxt()
LR = Cells(Rows.Count, "A").End(xlUp).Row
Last = Cells(Rows.Count, "D").End(xlUp).Row
clryellow = RGB(256, 256, 0)


ThisWorkbook.Sheets("Rankings").Select
Sheets("Rankings").Select
ActiveSheet.Range("A1:H1").Select
 Selection.AutoFilter
  ActiveWorkbook.Worksheets("Rankings").AutoFilter.Sort.SortFields.Clear
   ActiveWorkbook.Worksheets("Rankings").AutoFilter.Sort.SortFields.Add Key:= _
    Range("H1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
With ActiveWorkbook.Worksheets("Rankings").AutoFilter.Sort
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

ThisWorkbook.Sheets("Summary").Activate
Sheets("Summary").Select
Sheets("Summary").Range("A8:A18").Value = Sheets("Rankings").Range("A2:A12").Value
Sheets("Summary").Range("B8:B18").Value = Sheets("Rankings").Range("E2:E12").Value
Sheets("Summary").Range("C8:C18").Value = Sheets("Rankings").Range("G2:G12").Value
Sheets("Summary").Range("D8:D18").Value = Sheets("Rankings").Range("H2:H12").Value

ActiveWorkbook.Sheets("Summary").Activate
With ActiveSheet
For x = Last To 8 Step -1
    If (Cells(x, "D").Value) >= 6 Then
        Cells(x, "A").EntireRow.Delete
    ElseIf (Cells(x, 4).Value) < 6 Then
        Cells(x, 1).Interior.Color = clryellow
        Cells(x, 1).Font.Bold = True
        Cells(x, 4).Interior.Color = clryellow
        Cells(x, 4).Font.Bold = True
    End If
Next x
End With

For Each Worksheet In ActiveWorkbook.Worksheets
 ActiveSheet.Calculate
Next Worksheet

end sub

1 个答案:

答案 0 :(得分:1)

您可以.Select将一个或多个对象(工作表,单元格等)放入集合中,但只能.Activate其中一个。无论激活什么都是选择的一部分,即使它们都是相同的单个对象。您不需要两者。选择和。激活对象,除非您选择多个对象并要求其中一个对象为ActiveCell或ActiveSheet。

基本上,应使用.Select方法或.Activate method将工作表或范围对象引起用户的注意。没有必要选择或激活某些东西以便使用它(您的价值转移就是这样)。

这是对您的例程的简短重写,避免依赖.Select和.Activate来引用对象。

Sub summarizeRankings()
    Dim lstA As Long, lstD As Long, clrYellow As Long, x As Long, ws As Worksheet

    With ThisWorkbook
        With .Worksheets("Rankings")
            If .AutoFilterMode Then .AutoFilterMode = False
            With .Cells(1, 1).CurrentRegion
                With .Resize(.Rows.Count, 8)
                    .Cells.Sort Key1:=.Columns(8), Order1:=xlAscending, _
                                Orientation:=xlTopToBottom, Header:=xlYes
                    .AutoFilter
                End With
            End With
            Set ws = .Cells(1, 1).Parent
        End With
        With .Worksheets("Summary")
            .Range("A8:A18").Value = ws.Range("A2:A12").Value
            .Range("B8:B18").Value = ws.Range("E2:E12").Value
            .Range("C8:C18").Value = ws.Range("G2:G12").Value
            .Range("D8:D18").Value = ws.Range("H2:H12").Value

            lstA = .Cells(Rows.Count, "A").End(xlUp).Row
            lstD = .Cells(Rows.Count, "D").End(xlUp).Row
            clrYellow = RGB(256, 256, 0)

            For x = lstD To 8 Step -1
                If (.Cells(x, "D").Value) >= 6 Then
                    .Cells(x, "A").EntireRow.Delete
                ElseIf (.Cells(x, 4).Value) < 6 Then
                    .Cells(x, 1).Interior.Color = clrYellow
                    .Cells(x, 1).Font.Bold = True
                    .Cells(x, 4).Interior.Color = clrYellow
                    .Cells(x, 4).Font.Bold = True
                End If
            Next x
            .Activate  '<-last step brings the Summary worksheet to the front
        End With
    End With

    Application.Calculate

End Sub

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