VBA + Excel中的数组

时间:2017-11-15 11:36:47

标签: excel vba excel-vba

我编写了一个宏,它应该根据给定的值来读取每个工作表(行和列)中的值,应该锁定单元格或保持解锁状态。现在编写代码的方式需要永远计算。我被建议使用数组完成。但是阵列也无法正常工作

我的excel文件有15张。 我的代码如下。

Private Sub Workbook_Open()

    Dim sh As Object
    Dim sheetnames As String
    Dim i As Integer
    Dim col As Range
    Dim rng As Variant: Set rng = Application.Range("I16:BI300") 'Value Lock & Unlock is in Column Range I16 to BI16 and Row Range B16 to B300
    Dim rngCell As Variant

    Application.ScreenUpdating = False

        For Each sh In Sheets 'First Each

            If sh.Name <> "Configuration" Then 'Configuration If
                sheetnames = sh.Name
                Worksheets(sheetnames).Activate
                ActiveSheet.Unprotect Password:="sos"

                For Each rngCell In Range("I22:BI300")

                    If (Cells(1, rngCell.Column) = "Lock" And Cells(rngCell.Row, 1) = "Lock") Or (Cells(1, rngCell.Column) = "UnLock" And Cells(rngCell.Row, 1) = "Lock") Or (Cells(1, rngCell.Column) = "Lock" And Cells(rngCell.Row, 1) = "Unlock") Then
                        rngCell.Locked = True
                        rngCell.Font.Color = -16776961
                    Else
                        rngCell.Locked = False
                        rngCell.Font.ColorIndex = xlAutomatic
                    End If

                Next rngCell

                ActiveSheet.Protect Password:="sos"
            End If 'End of Configuration If

        Next sh 'End of First Each

    Sheets(1).Select

End Sub

根据Column和Rows中值的组合,结果应该产生值。

Column  Row Value
Lock    Lock    Lock
Unlock  Lock    Lock
Lock    Unlock  Lock
Unlock  Unlock  Unlock

1 个答案:

答案 0 :(得分:1)

我不确定数组是如何加速这一点的,实际上是单元的锁定/解锁导致主速度问题(尽管数组可以改善读取时间)。无论如何,我建议将你希望锁定/解锁的值设置为一个范围,然后一次性完成,而不是单独进行,因为这将是你的主要性能影响。

Private Sub Workbook_Open()
    Dim sh As Object
    Dim sheetnames As String
    Dim i As Integer
    Dim col As Range, LockRng As Range, UnLockRng As Range
    Dim rng As Variant: Set rng = Application.Range("I16:BI300") 'Value Lock & Unlock is in Column Range I16 to BI16 and Row Range B16 to B300
    Dim rngCell     As Variant
    Application.ScreenUpdating = False
        For Each sh In Sheets   'First Each
            ' Reset Ranges for each sheet
            Set LockRng = Nothing
            Set UnLockRng = Nothing

            If sh.Name <> "Configuration" Then      'Configuration If
                sheetnames = sh.Name
                Worksheets(sheetnames).Activate
                ActiveSheet.Unprotect Password:="sos"
                For Each rngCell In Range("I22:BI300")
                    If (Cells(1, rngCell.Column) = "Lock" And Cells(rngCell.Row, 1) = "Lock") _
                        Or (Cells(1, rngCell.Column) = "UnLock" And Cells(rngCell.Row, 1) = "Lock") _
                        Or (Cells(1, rngCell.Column) = "Lock" And Cells(rngCell.Row, 1) = "Unlock") Then
                            ' Create LockRng
                            If LockRng Is Nothing Then
                                Set LockRng = rngCell
                            Else
                                Set LockRng = Union(LockRng, rngCell)
                            End If
                    Else
                        ' Create UnLockRng
                        If UnLockRng Is Nothing Then
                            Set UnLockRng = rngCell
                        Else
                            Set UnLockRng = Union(UnLockRng, rngCell)
                        End If
                    End If
                Next rngCell
                ActiveSheet.Protect Password:="sos"
            End If                      'End of Configuration If
            ' Lock all cells in LockRng
            If Not LockRng Is Nothing Then
                LockRng.Locked = True
                LockRng.Font.Color = -16776961
            End If
            ' Unlock all cells in UnLockRng
            If Not UnLockRng Is Nothing Then
                UnLockRng.Locked = False
                UnLockRng.Font.ColorIndex = xlAutomatic
            End If
        Next sh     'End of First Each
    Sheets(1).Select
End Sub