VBA宏锁定Excel，宏没有完成，正在工作

时间：2015-02-23 12:48:28

标签： excel-vba copy-paste hidden freeze autofilter

以下代码适用于我已经工作了几个月的多页价格表。基本上，每个部门在工作表中有三个页面：一个包含所有数据的“Mstr”页面，一个带有用于数据选择的活动X控件的“Rate Adj”页面，以及一个显示您选择结果的输出页面。我所有其他部门的宏运行正常。这个工作正在进行中。由于某种原因，它已经开始锁定，我无法弄清楚原因。该部门有4个产品类型复选框，1个复位复选框和1个速率调整按钮，用于折扣价格。所有页面都是安全的并受密码保护。我已经包含了一个产品类型的代码复选框以及重置复选框和费率调整按钮。

    Private Sub CheckBox230_Click()

    If CheckBox230.Value = True Then

    Sheets("Mstr_Chem").Unprotect Password:="jeff"
    Sheets("Chemicals").Unprotect Password:="jeff"


        Dim allviscells As Range
        Dim lastrow As Long

        With Sheets("Mstr_Chem")
        .Range("A5:O250").AutoFilter Field:=1, Criteria1:="=400"
        .Range("A5:O250").AutoFilter Field:=14, Criteria1:="=Active"
        .Columns("C").Hidden = True
        .Columns("D").Hidden = True
        .Columns("E").Hidden = True
        .Columns("I").Hidden = True
        .Columns("J").Hidden = True
        .Columns("K").Hidden = True
        .Columns("L").Hidden = True
        .Columns("M").Hidden = True
        .Columns("N").Hidden = True
        Set allviscells = Sheets("Mstr_Chem").Range("A6:O250").SpecialCells(xlCellTypeVisible)
            allviscells.Copy
        lastrow = Sheets("Chemicals").Range("A250").End(xlUp).row
            Sheets("Chemicals").Cells(lastrow + 1, 1).PasteSpecial xlPasteValues
            Sheets("Chemicals").Cells(lastrow + 1, 1).PasteSpecial xlPasteFormats
            Sheets("Chemicals").Range("A6:F250").WrapText = False
            Sheets("Chemicals").Columns("A:F").AutoFit
            Sheets("Chemicals").Range("G6:G250").WrapText = True
        End With

    End If

   Sheets("Mstr_Chem").Protect Password:="jeff"
   Sheets("Chemicals").Protect Password:="jeff"

   End Sub


    Private Sub CommandButtonRateAdj3_Click()

    Sheets("Chemicals").Unprotect Password:="jeff"

    Dim rng As Range, cell As Range
    Set rng = Sheets("Chemicals").Range("F6:F200")
    Set Y = Sheets("Rate Adj").Range("D22")

        For Each cell In rng
        If IsNumeric(cell.Value) Then
        cell.Value = Round((cell.Value - (Y * cell.Value)), 0)
        End If

        If Not IsNumeric(cell.Value) Then
        cell.Value = cell.Value
        End If

        If cell.Value < 1 Then
        cell.Value = Null
        End If


    Next cell

    Sheets("Chemicals").Protect Password:="jeff"

    End Sub    

    Private Sub CheckBox234_Click()

    Sheets("Mstr_Chem").Unprotect Password:="jeff"

    If CheckBox234.Value = True Then
     Sheets("Mstr_Chem").Cells.AutoFilter
     CheckBox230.Value = False
     CheckBox230.Enabled = False
     CheckBox231.Value = False
     CheckBox231.Enabled = False
     CheckBox232.Value = False
     CheckBox232.Enabled = False
     CheckBox233.Value = False
     CheckBox233.Enabled = False
     Sheets("Rate Adj").Range("D22").Value = Null
     End If

    If CheckBox234.Value = False Then
     CheckBox230.Enabled = True
     CheckBox231.Enabled = True
     CheckBox232.Enabled = True
     CheckBox233.Enabled = True

        With Sheets("Mstr_Chem")
        .Columns("C").Hidden = False
        .Columns("D").Hidden = False
        .Columns("E").Hidden = False
        .Columns("I").Hidden = False
        .Columns("J").Hidden = False
        .Columns("K").Hidden = False
        .Columns("L").Hidden = False
        .Columns("N").Hidden = False
        .Columns("O").Hidden = False
        End With
    End If

    Sheets("Mstr_Chem").Protect Password:="jeff"

    Sheets("Chemicals").Unprotect Password:="jeff"
    Sheets("Chemicals").Range("A6:Z150").Value = Null
    Sheets("Chemicals").Range("A6:Z150").ClearFormats
    Sheets("Chemicals").Protect Password:="jeff"

    End Sub

1 个答案:

答案 0 :(得分：0)

以下是我在评论中提到的一个例子：

Private bSkipEvents           As Boolean
Private Sub CheckBox230_Click()
    ' to avoid recursion
    If bSkipEvents Then Exit Sub

    If CheckBox230.Value = True Then

        Sheets("Mstr_Chem").Unprotect Password:="jeff"
        Sheets("Chemicals").Unprotect Password:="jeff"


        Dim allviscells       As Range
        Dim lastrow           As Long

        With Sheets("Mstr_Chem")
            .Range("A5:O250").AutoFilter Field:=1, Criteria1:="=400"
            .Range("A5:O250").AutoFilter Field:=14, Criteria1:="=Active"
            .Columns("C").Hidden = True
            .Columns("D").Hidden = True
            .Columns("E").Hidden = True
            .Columns("I").Hidden = True
            .Columns("J").Hidden = True
            .Columns("K").Hidden = True
            .Columns("L").Hidden = True
            .Columns("M").Hidden = True
            .Columns("N").Hidden = True
            Set allviscells = Sheets("Mstr_Chem").Range("A6:O250").SpecialCells(xlCellTypeVisible)
            allviscells.Copy
            lastrow = Sheets("Chemicals").Range("A250").End(xlUp).Row
            Sheets("Chemicals").Cells(lastrow + 1, 1).PasteSpecial xlPasteValues
            Sheets("Chemicals").Cells(lastrow + 1, 1).PasteSpecial xlPasteFormats
            Sheets("Chemicals").Range("A6:F250").WrapText = False
            Sheets("Chemicals").Columns("A:F").AutoFit
            Sheets("Chemicals").Range("G6:G250").WrapText = True
        End With

    End If

    Sheets("Mstr_Chem").Protect Password:="jeff"
    Sheets("Chemicals").Protect Password:="jeff"

End Sub


Private Sub CommandButtonRateAdj3_Click()
    ' to avoid recursion
    If bSkipEvents Then Exit Sub

    Sheets("Chemicals").Unprotect Password:="jeff"

    Dim rng As Range, cell    As Range
    Set rng = Sheets("Chemicals").Range("F6:F200")
    Set y = Sheets("Rate Adj").Range("D22")

    For Each cell In rng
        If IsNumeric(cell.Value) Then
            cell.Value = Round((cell.Value - (y * cell.Value)), 0)
        End If

        If Not IsNumeric(cell.Value) Then
            cell.Value = cell.Value
        End If

        If cell.Value < 1 Then
            cell.Value = Null
        End If


    Next cell

    Sheets("Chemicals").Protect Password:="jeff"

End Sub

Private Sub CheckBox234_Click()
    ' to avoid recursion
    If bSkipEvents Then Exit Sub
    Sheets("Mstr_Chem").Unprotect Password:="jeff"
    bSkipEvents = True
    If CheckBox234.Value = True Then
        Sheets("Mstr_Chem").Cells.AutoFilter
        CheckBox230.Value = False
        CheckBox230.Enabled = False
        CheckBox231.Value = False
        CheckBox231.Enabled = False
        CheckBox232.Value = False
        CheckBox232.Enabled = False
        CheckBox233.Value = False
        CheckBox233.Enabled = False
        Sheets("Rate Adj").Range("D22").Value = Null
    End If

    If CheckBox234.Value = False Then
        CheckBox230.Enabled = True
        CheckBox231.Enabled = True
        CheckBox232.Enabled = True
        CheckBox233.Enabled = True

        With Sheets("Mstr_Chem")
            .Columns("C").Hidden = False
            .Columns("D").Hidden = False
            .Columns("E").Hidden = False
            .Columns("I").Hidden = False
            .Columns("J").Hidden = False
            .Columns("K").Hidden = False
            .Columns("L").Hidden = False
            .Columns("N").Hidden = False
            .Columns("O").Hidden = False
        End With
    End If

    Sheets("Mstr_Chem").Protect Password:="jeff"

    Sheets("Chemicals").Unprotect Password:="jeff"
    Sheets("Chemicals").Range("A6:Z150").Value = Null
    Sheets("Chemicals").Range("A6:Z150").ClearFormats
    Sheets("Chemicals").Protect Password:="jeff"

    bSkipEvents = False
End Sub
相关问题
最新问题