Question

我正在处理一个包含许多不同宏（大约20个）的工作表，其中大部分都是通过按钮（表单控件）成功激活的。

按钮没有正确激活我的最后一个宏。看起来宏正在部分运行然后停止，但没有错误。如果我推动＆＃34;播放＆＃34;视觉基本环境中的按钮工作正常。

我查看了按钮后面的代码并正确分配了宏。我更改了按钮，我更改了宏的名称（没有空格等），但它没有帮助。

其余的仍然正常，所以不涉及更新等有人知道可能是什么问题吗？我正在使用的代码如下：

Sub find_overdue()
    Application.ScreenUpdating = False

    Dim lr&, i&, k&

    k = 1
    Worksheets("search results").Range("A:F").ClearContents
    Worksheets("search results").Range("A:F").ClearFormats

    Worksheets("overdue").Activate
    Range("A1").Activate

    lr = Range("D" & Rows.Count).End(xlUp).Row

    k = 1

    For i = 1 To lr
        If Cells(i, "D").Value = "OVERDUE" Then
            Cells(i, "A").Copy
            Worksheets("search results").Range("A" & k).PasteSpecial Paste:=xlValues
            Cells(i, "B").Copy
            Worksheets("search results").Range("B" & k).PasteSpecial Paste:=xlValues
            Cells(i, "C").Copy
            Worksheets("search results").Range("C" & k).PasteSpecial Paste:=xlValues
            Cells(i, "D").Copy
            Worksheets("search results").Range("D" & k).PasteSpecial Paste:=xlValues

            k = k + 1
        End If
    Next i

    Worksheets("search results").Columns("A:F").AutoFit
    Worksheets("search results").Activate

    Range("A1").EntireRow.Insert

    Range("A1") = "Tag & Work"
    Range("B1") = "Last Date"
    Range("C1") = "Due Date"
    Range("D1") = "status"  

    Worksheets("search results").Range("A1:F1").Font.Bold = True
    Worksheets("search results").Range("A1:F1").HorizontalAlignment = xlCenter

    Range("B:B").NumberFormat = "dd/mm/yyyy;@"
    Range("C:C").NumberFormat = "dd/mm/yyyy;@"

    Columns("A:D").Select
    ActiveWorkbook.Worksheets("search results").sort.SortFields.Clear
    ActiveWorkbook.Worksheets("search results").sort.SortFields.Add Key:=Range( _
      "C:C"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
      xlSortNormal

    With ActiveWorkbook.Worksheets("search results").sort
        .SetRange Range("A:D")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    Worksheets("search results").Activate
    Range("A1").Activate
End Sub

正如你所看到的，我正在改变两张（＆＃34;逾期＆＃34;和＃34;搜索结果＆＃34;）因此工作表激活，我的按钮在第三张纸上。

Answer 1

删除.Activate部分并为每个范围指定具体工作表应该修复它。

如果你在开头设置.ScreenUpdating = True，最后也不要忘记False。

Option Explicit

Public Sub find_overdue()
    Application.ScreenUpdating = False

    Dim lr As Long, i As Long, k As Long

    Dim wsResults As Worksheet
    Set wsResults = Worksheets("search results")
    With wsResults.Range("A:F")
        .ClearContents
        .ClearFormats
    End If

    Dim wsOverdue As Worksheet
    Set wsOverdue = Worksheets("overdue")
    With wsOverdue
        lr = .Range("D" & .Rows.Count).End(xlUp).Row
        k = 1

        For i = 1 To lr
            If .Cells(i, "D").Value = "OVERDUE" Then
                .Cells(i, "A").Copy
                wsResults.Range("A" & k).PasteSpecial Paste:=xlValues
                .Cells(i, "B").Copy
                wsResults.Range("B" & k).PasteSpecial Paste:=xlValues
                .Cells(i, "C").Copy
                wsResults.Range("C" & k).PasteSpecial Paste:=xlValues
                .Cells(i, "D").Copy
                wsResults.Range("D" & k).PasteSpecial Paste:=xlValues

                k = k + 1
            End If
        Next i

        wsResults.Columns("A:F").AutoFit

        .Range("A1").EntireRow.Insert
        .Range("A1") = "Tag & Work"
        .Range("B1") = "Last Date"
        .Range("C1") = "Due Date"
        .Range("D1") = "status"

        wsResults.Range("A1:F1").Font.Bold = True
        wsResults.Range("A1:F1").HorizontalAlignment = xlCenter

        .Range("B:C").NumberFormat = "dd/mm/yyyy;@" 'instead of B:B and C:C we can use B:C
    End With

    With wsResults.Sort
        .SortFields.Clear
        .SortFields.Add Key:=wsResults.Range("C:C"), SortOn:=xlSortOnValues, _
           Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange wsResults.Range("A:D")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    Application.ScreenUpdating = True 'Don't forget to activate screen updating in the end!
End Sub

宏按钮不像其他

1 个答案: